2008 lines
63 KiB
Ada
2008 lines
63 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- P A R . C H 9 --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
-- for more details. You should have received a copy of the GNU General --
|
|
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
pragma Style_Checks (All_Checks);
|
|
-- Turn off subprogram body ordering check. Subprograms are in order by RM
|
|
-- section rather than alphabetical.
|
|
|
|
separate (Par)
|
|
package body Ch9 is
|
|
|
|
-- Local subprograms, used only in this chapter
|
|
|
|
function P_Accept_Alternative return Node_Id;
|
|
function P_Delay_Alternative return Node_Id;
|
|
function P_Delay_Relative_Statement return Node_Id;
|
|
function P_Delay_Until_Statement return Node_Id;
|
|
function P_Entry_Barrier return Node_Id;
|
|
function P_Entry_Body_Formal_Part return Node_Id;
|
|
function P_Entry_Declaration return Node_Id;
|
|
function P_Entry_Index_Specification return Node_Id;
|
|
function P_Protected_Definition return Node_Id;
|
|
function P_Protected_Operation_Declaration_Opt return Node_Id;
|
|
function P_Protected_Operation_Items return List_Id;
|
|
function P_Task_Items return List_Id;
|
|
function P_Task_Definition return Node_Id;
|
|
|
|
-----------------------------
|
|
-- 9.1 Task (also 10.1.3) --
|
|
-----------------------------
|
|
|
|
-- TASK_TYPE_DECLARATION ::=
|
|
-- task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
|
|
-- [ASPECT_SPECIFICATIONS]
|
|
-- [is [new INTERFACE_LIST with] TASK_DEFINITION];
|
|
|
|
-- SINGLE_TASK_DECLARATION ::=
|
|
-- task DEFINING_IDENTIFIER
|
|
-- [ASPECT_SPECIFICATIONS]
|
|
-- [is [new INTERFACE_LIST with] TASK_DEFINITION];
|
|
|
|
-- TASK_BODY ::=
|
|
-- task body DEFINING_IDENTIFIER [ASPECT_SPECIFICATIONS] is
|
|
-- DECLARATIVE_PART
|
|
-- begin
|
|
-- HANDLED_SEQUENCE_OF_STATEMENTS
|
|
-- end [task_IDENTIFIER]
|
|
|
|
-- TASK_BODY_STUB ::=
|
|
-- task body DEFINING_IDENTIFIER is separate
|
|
-- [ASPECT_SPECIFICATIONS];
|
|
|
|
-- This routine scans out a task declaration, task body, or task stub
|
|
|
|
-- The caller has checked that the initial token is TASK and scanned
|
|
-- past it, so that Token is set to the token after TASK
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
function P_Task return Node_Id is
|
|
Aspect_Sloc : Source_Ptr := No_Location;
|
|
Name_Node : Node_Id;
|
|
Task_Node : Node_Id;
|
|
Task_Sloc : Source_Ptr;
|
|
|
|
Dummy_Node : constant Node_Id := New_Node (N_Task_Body, Token_Ptr);
|
|
-- Placeholder node used to hold legal or prematurely declared aspect
|
|
-- specifications. Depending on the context, the aspect specifications
|
|
-- may be moved to a new node.
|
|
|
|
begin
|
|
Push_Scope_Stack;
|
|
Scopes (Scope.Last).Etyp := E_Name;
|
|
Scopes (Scope.Last).Ecol := Start_Column;
|
|
Scopes (Scope.Last).Sloc := Token_Ptr;
|
|
Scopes (Scope.Last).Lreq := False;
|
|
Task_Sloc := Prev_Token_Ptr;
|
|
|
|
if Token = Tok_Body then
|
|
Scan; -- past BODY
|
|
Name_Node := P_Defining_Identifier (C_Is);
|
|
Scopes (Scope.Last).Labl := Name_Node;
|
|
Current_Node := Name_Node;
|
|
|
|
if Token = Tok_Left_Paren then
|
|
Error_Msg_SC ("discriminant part not allowed in task body");
|
|
Discard_Junk_List (P_Known_Discriminant_Part_Opt);
|
|
end if;
|
|
|
|
if Aspect_Specifications_Present then
|
|
Aspect_Sloc := Token_Ptr;
|
|
P_Aspect_Specifications (Dummy_Node, Semicolon => False);
|
|
end if;
|
|
|
|
TF_Is;
|
|
|
|
-- Task stub
|
|
|
|
if Token = Tok_Separate then
|
|
Scan; -- past SEPARATE
|
|
Task_Node := New_Node (N_Task_Body_Stub, Task_Sloc);
|
|
Set_Defining_Identifier (Task_Node, Name_Node);
|
|
|
|
if Has_Aspects (Dummy_Node) then
|
|
Error_Msg
|
|
("aspect specifications must come after SEPARATE",
|
|
Aspect_Sloc);
|
|
end if;
|
|
|
|
P_Aspect_Specifications (Task_Node, Semicolon => False);
|
|
TF_Semicolon;
|
|
Pop_Scope_Stack; -- remove unused entry
|
|
|
|
-- Task body
|
|
|
|
else
|
|
Task_Node := New_Node (N_Task_Body, Task_Sloc);
|
|
Set_Defining_Identifier (Task_Node, Name_Node);
|
|
|
|
-- Move the aspect specifications to the body node
|
|
|
|
if Has_Aspects (Dummy_Node) then
|
|
Move_Aspects (From => Dummy_Node, To => Task_Node);
|
|
end if;
|
|
|
|
Parse_Decls_Begin_End (Task_Node);
|
|
|
|
-- The statement list of a task body needs to include at least a
|
|
-- null statement, so if a parsing error produces an empty list,
|
|
-- patch it now.
|
|
|
|
if No (First (Statements
|
|
(Handled_Statement_Sequence (Task_Node))))
|
|
then
|
|
Set_Statements (Handled_Statement_Sequence (Task_Node),
|
|
New_List (Make_Null_Statement (Token_Ptr)));
|
|
end if;
|
|
end if;
|
|
|
|
return Task_Node;
|
|
|
|
-- Otherwise we must have a task declaration
|
|
|
|
else
|
|
if Token = Tok_Type then
|
|
Scan; -- past TYPE
|
|
Task_Node := New_Node (N_Task_Type_Declaration, Task_Sloc);
|
|
Name_Node := P_Defining_Identifier;
|
|
Set_Defining_Identifier (Task_Node, Name_Node);
|
|
Scopes (Scope.Last).Labl := Name_Node;
|
|
Current_Node := Name_Node;
|
|
Set_Discriminant_Specifications
|
|
(Task_Node, P_Known_Discriminant_Part_Opt);
|
|
|
|
else
|
|
Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc);
|
|
Name_Node := P_Defining_Identifier (C_Is);
|
|
Set_Defining_Identifier (Task_Node, Name_Node);
|
|
Scopes (Scope.Last).Labl := Name_Node;
|
|
Current_Node := Name_Node;
|
|
|
|
if Token = Tok_Left_Paren then
|
|
Error_Msg_SC ("discriminant part not allowed for single task");
|
|
Discard_Junk_List (P_Known_Discriminant_Part_Opt);
|
|
end if;
|
|
end if;
|
|
|
|
-- Scan aspect specifications, don't eat the semicolon, since it
|
|
-- might not be there if we have an IS.
|
|
|
|
P_Aspect_Specifications (Task_Node, Semicolon => False);
|
|
|
|
-- Parse optional task definition. Note that P_Task_Definition scans
|
|
-- out the semicolon and possible aspect specifications as well as
|
|
-- the task definition itself.
|
|
|
|
if Token = Tok_Semicolon then
|
|
|
|
-- A little check, if the next token after semicolon is Entry,
|
|
-- then surely the semicolon should really be IS
|
|
|
|
Scan; -- past semicolon
|
|
|
|
if Token = Tok_Entry then
|
|
Error_Msg_SP -- CODEFIX
|
|
("|"";"" should be IS");
|
|
Set_Task_Definition (Task_Node, P_Task_Definition);
|
|
else
|
|
Pop_Scope_Stack; -- Remove unused entry
|
|
end if;
|
|
|
|
-- Here we have a task definition
|
|
|
|
else
|
|
TF_Is; -- must have IS if no semicolon
|
|
|
|
-- Ada 2005 (AI-345)
|
|
|
|
if Token = Tok_New then
|
|
Scan; -- past NEW
|
|
|
|
Error_Msg_Ada_2005_Extension ("task interface");
|
|
|
|
Set_Interface_List (Task_Node, New_List);
|
|
|
|
loop
|
|
Append (P_Qualified_Simple_Name, Interface_List (Task_Node));
|
|
exit when Token /= Tok_And;
|
|
Scan; -- past AND
|
|
end loop;
|
|
|
|
if Token /= Tok_With then
|
|
Error_Msg_SC -- CODEFIX
|
|
("WITH expected");
|
|
end if;
|
|
|
|
Scan; -- past WITH
|
|
|
|
if Token = Tok_Private then
|
|
Error_Msg_SP -- CODEFIX
|
|
("PRIVATE not allowed in task type declaration");
|
|
end if;
|
|
end if;
|
|
|
|
Set_Task_Definition (Task_Node, P_Task_Definition);
|
|
end if;
|
|
|
|
return Task_Node;
|
|
end if;
|
|
end P_Task;
|
|
|
|
--------------------------------
|
|
-- 9.1 Task Type Declaration --
|
|
--------------------------------
|
|
|
|
-- Parsed by P_Task (9.1)
|
|
|
|
----------------------------------
|
|
-- 9.1 Single Task Declaration --
|
|
----------------------------------
|
|
|
|
-- Parsed by P_Task (9.1)
|
|
|
|
--------------------------
|
|
-- 9.1 Task Definition --
|
|
--------------------------
|
|
|
|
-- TASK_DEFINITION ::=
|
|
-- {TASK_ITEM}
|
|
-- [private
|
|
-- {TASK_ITEM}]
|
|
-- end [task_IDENTIFIER];
|
|
|
|
-- The caller has already made the scope stack entry
|
|
|
|
-- Note: there is a small deviation from official syntax here in that we
|
|
-- regard the semicolon after end as part of the Task_Definition, and in
|
|
-- the official syntax, it's part of the enclosing declaration. The reason
|
|
-- for this deviation is that otherwise the end processing would have to
|
|
-- be special cased, which would be a nuisance.
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
function P_Task_Definition return Node_Id is
|
|
Def_Node : Node_Id;
|
|
|
|
begin
|
|
Def_Node := New_Node (N_Task_Definition, Token_Ptr);
|
|
Set_Visible_Declarations (Def_Node, P_Task_Items);
|
|
|
|
if Token = Tok_Private then
|
|
Scan; -- past PRIVATE
|
|
Set_Private_Declarations (Def_Node, P_Task_Items);
|
|
|
|
-- Deal gracefully with multiple PRIVATE parts
|
|
|
|
while Token = Tok_Private loop
|
|
Error_Msg_SC ("only one private part allowed per task");
|
|
Scan; -- past PRIVATE
|
|
Append_List (P_Task_Items, Private_Declarations (Def_Node));
|
|
end loop;
|
|
end if;
|
|
|
|
End_Statements (Def_Node);
|
|
return Def_Node;
|
|
end P_Task_Definition;
|
|
|
|
--------------------
|
|
-- 9.1 Task Item --
|
|
--------------------
|
|
|
|
-- TASK_ITEM ::= ENTRY_DECLARATION | REPRESENTATION_CLAUSE
|
|
|
|
-- This subprogram scans a (possibly empty) list of task items and pragmas
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
-- Note: a pragma can also be returned in this position
|
|
|
|
function P_Task_Items return List_Id is
|
|
Items : List_Id;
|
|
Item_Node : Node_Id;
|
|
Decl_Sloc : Source_Ptr;
|
|
|
|
begin
|
|
-- Get rid of active SIS entry from outer scope. This means we will
|
|
-- miss some nested cases, but it doesn't seem worth the effort. See
|
|
-- discussion in Par for further details
|
|
|
|
SIS_Entry_Active := False;
|
|
|
|
-- Loop to scan out task items
|
|
|
|
Items := New_List;
|
|
|
|
Decl_Loop : loop
|
|
Decl_Sloc := Token_Ptr;
|
|
|
|
if Token = Tok_Pragma then
|
|
P_Pragmas_Opt (Items);
|
|
|
|
-- Ada 2005 (AI-397): Reserved words NOT and OVERRIDING may begin an
|
|
-- entry declaration.
|
|
|
|
elsif Token = Tok_Entry
|
|
or else Token = Tok_Not
|
|
or else Token = Tok_Overriding
|
|
then
|
|
Append (P_Entry_Declaration, Items);
|
|
|
|
elsif Token = Tok_For then
|
|
|
|
-- Representation clause in task declaration. The only rep clause
|
|
-- which is legal in a protected declaration is an address clause,
|
|
-- so that is what we try to scan out.
|
|
|
|
Item_Node := P_Representation_Clause;
|
|
|
|
if Nkind (Item_Node) = N_At_Clause then
|
|
Append (Item_Node, Items);
|
|
|
|
elsif Nkind (Item_Node) = N_Attribute_Definition_Clause
|
|
and then Chars (Item_Node) = Name_Address
|
|
then
|
|
Append (Item_Node, Items);
|
|
|
|
else
|
|
Error_Msg
|
|
("the only representation clause " &
|
|
"allowed here is an address clause!", Decl_Sloc);
|
|
end if;
|
|
|
|
elsif Token = Tok_Identifier
|
|
or else Token in Token_Class_Declk
|
|
then
|
|
Error_Msg_SC ("illegal declaration in task definition");
|
|
Resync_Past_Semicolon;
|
|
|
|
else
|
|
exit Decl_Loop;
|
|
end if;
|
|
end loop Decl_Loop;
|
|
|
|
return Items;
|
|
end P_Task_Items;
|
|
|
|
--------------------
|
|
-- 9.1 Task Body --
|
|
--------------------
|
|
|
|
-- Parsed by P_Task (9.1)
|
|
|
|
----------------------------------
|
|
-- 9.4 Protected (also 10.1.3) --
|
|
----------------------------------
|
|
|
|
-- PROTECTED_TYPE_DECLARATION ::=
|
|
-- protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
|
|
-- [ASPECT_SPECIFICATIONS]
|
|
-- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
|
|
|
|
-- SINGLE_PROTECTED_DECLARATION ::=
|
|
-- protected DEFINING_IDENTIFIER
|
|
-- [ASPECT_SPECIFICATIONS]
|
|
-- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
|
|
|
|
-- PROTECTED_BODY ::=
|
|
-- protected body DEFINING_IDENTIFIER
|
|
-- [ASPECT_SPECIFICATIONS]
|
|
-- is
|
|
-- {PROTECTED_OPERATION_ITEM}
|
|
-- end [protected_IDENTIFIER];
|
|
|
|
-- PROTECTED_BODY_STUB ::=
|
|
-- protected body DEFINING_IDENTIFIER is separate
|
|
-- [ASPECT_SPECIFICATIONS];
|
|
|
|
-- This routine scans out a protected declaration, protected body
|
|
-- or a protected stub.
|
|
|
|
-- The caller has checked that the initial token is PROTECTED and
|
|
-- scanned past it, so Token is set to the following token.
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
function P_Protected return Node_Id is
|
|
Aspect_Sloc : Source_Ptr := No_Location;
|
|
Name_Node : Node_Id;
|
|
Protected_Node : Node_Id;
|
|
Protected_Sloc : Source_Ptr;
|
|
Scan_State : Saved_Scan_State;
|
|
|
|
Dummy_Node : constant Node_Id := New_Node (N_Protected_Body, Token_Ptr);
|
|
-- Placeholder node used to hold legal or prematurely declared aspect
|
|
-- specifications. Depending on the context, the aspect specifications
|
|
-- may be moved to a new node.
|
|
|
|
begin
|
|
Push_Scope_Stack;
|
|
Scopes (Scope.Last).Etyp := E_Name;
|
|
Scopes (Scope.Last).Ecol := Start_Column;
|
|
Scopes (Scope.Last).Lreq := False;
|
|
Protected_Sloc := Prev_Token_Ptr;
|
|
|
|
if Token = Tok_Body then
|
|
Scan; -- past BODY
|
|
Name_Node := P_Defining_Identifier (C_Is);
|
|
Scopes (Scope.Last).Labl := Name_Node;
|
|
Current_Node := Name_Node;
|
|
|
|
if Token = Tok_Left_Paren then
|
|
Error_Msg_SC ("discriminant part not allowed in protected body");
|
|
Discard_Junk_List (P_Known_Discriminant_Part_Opt);
|
|
end if;
|
|
|
|
if Aspect_Specifications_Present then
|
|
Aspect_Sloc := Token_Ptr;
|
|
P_Aspect_Specifications (Dummy_Node, Semicolon => False);
|
|
end if;
|
|
|
|
TF_Is;
|
|
|
|
-- Protected stub
|
|
|
|
if Token = Tok_Separate then
|
|
Scan; -- past SEPARATE
|
|
|
|
Protected_Node := New_Node (N_Protected_Body_Stub, Protected_Sloc);
|
|
Set_Defining_Identifier (Protected_Node, Name_Node);
|
|
|
|
if Has_Aspects (Dummy_Node) then
|
|
Error_Msg
|
|
("aspect specifications must come after SEPARATE",
|
|
Aspect_Sloc);
|
|
end if;
|
|
|
|
P_Aspect_Specifications (Protected_Node, Semicolon => False);
|
|
TF_Semicolon;
|
|
Pop_Scope_Stack; -- remove unused entry
|
|
|
|
-- Protected body
|
|
|
|
else
|
|
Protected_Node := New_Node (N_Protected_Body, Protected_Sloc);
|
|
Set_Defining_Identifier (Protected_Node, Name_Node);
|
|
|
|
Move_Aspects (From => Dummy_Node, To => Protected_Node);
|
|
Set_Declarations (Protected_Node, P_Protected_Operation_Items);
|
|
End_Statements (Protected_Node);
|
|
end if;
|
|
|
|
return Protected_Node;
|
|
|
|
-- Otherwise we must have a protected declaration
|
|
|
|
else
|
|
if Token = Tok_Type then
|
|
Scan; -- past TYPE
|
|
Protected_Node :=
|
|
New_Node (N_Protected_Type_Declaration, Protected_Sloc);
|
|
Name_Node := P_Defining_Identifier (C_Is);
|
|
Set_Defining_Identifier (Protected_Node, Name_Node);
|
|
Scopes (Scope.Last).Labl := Name_Node;
|
|
Current_Node := Name_Node;
|
|
Set_Discriminant_Specifications
|
|
(Protected_Node, P_Known_Discriminant_Part_Opt);
|
|
|
|
else
|
|
Protected_Node :=
|
|
New_Node (N_Single_Protected_Declaration, Protected_Sloc);
|
|
Name_Node := P_Defining_Identifier (C_Is);
|
|
Set_Defining_Identifier (Protected_Node, Name_Node);
|
|
|
|
if Token = Tok_Left_Paren then
|
|
Error_Msg_SC
|
|
("discriminant part not allowed for single protected");
|
|
Discard_Junk_List (P_Known_Discriminant_Part_Opt);
|
|
end if;
|
|
|
|
Scopes (Scope.Last).Labl := Name_Node;
|
|
Current_Node := Name_Node;
|
|
end if;
|
|
|
|
P_Aspect_Specifications (Protected_Node, Semicolon => False);
|
|
|
|
-- Check for semicolon not followed by IS, this is something like
|
|
|
|
-- protected type r;
|
|
|
|
-- where we want
|
|
|
|
-- protected type r IS END;
|
|
|
|
if Token = Tok_Semicolon then
|
|
Save_Scan_State (Scan_State); -- at semicolon
|
|
Scan; -- past semicolon
|
|
|
|
if Token /= Tok_Is then
|
|
Restore_Scan_State (Scan_State);
|
|
Error_Msg_SC -- CODEFIX
|
|
("missing IS");
|
|
Set_Protected_Definition (Protected_Node,
|
|
Make_Protected_Definition (Token_Ptr,
|
|
Visible_Declarations => Empty_List,
|
|
End_Label => Empty));
|
|
|
|
SIS_Entry_Active := False;
|
|
End_Statements
|
|
(Protected_Definition (Protected_Node), Protected_Node);
|
|
return Protected_Node;
|
|
end if;
|
|
|
|
Error_Msg_SP -- CODEFIX
|
|
("|extra ""("" ignored");
|
|
end if;
|
|
|
|
T_Is;
|
|
|
|
-- Ada 2005 (AI-345)
|
|
|
|
if Token = Tok_New then
|
|
Scan; -- past NEW
|
|
|
|
Error_Msg_Ada_2005_Extension ("protected interface");
|
|
|
|
Set_Interface_List (Protected_Node, New_List);
|
|
|
|
loop
|
|
Append (P_Qualified_Simple_Name,
|
|
Interface_List (Protected_Node));
|
|
|
|
exit when Token /= Tok_And;
|
|
Scan; -- past AND
|
|
end loop;
|
|
|
|
if Token /= Tok_With then
|
|
Error_Msg_SC -- CODEFIX
|
|
("WITH expected");
|
|
end if;
|
|
|
|
Scan; -- past WITH
|
|
end if;
|
|
|
|
Set_Protected_Definition (Protected_Node, P_Protected_Definition);
|
|
return Protected_Node;
|
|
end if;
|
|
end P_Protected;
|
|
|
|
-------------------------------------
|
|
-- 9.4 Protected Type Declaration --
|
|
-------------------------------------
|
|
|
|
-- Parsed by P_Protected (9.4)
|
|
|
|
---------------------------------------
|
|
-- 9.4 Single Protected Declaration --
|
|
---------------------------------------
|
|
|
|
-- Parsed by P_Protected (9.4)
|
|
|
|
-------------------------------
|
|
-- 9.4 Protected Definition --
|
|
-------------------------------
|
|
|
|
-- PROTECTED_DEFINITION ::=
|
|
-- {PROTECTED_OPERATION_DECLARATION}
|
|
-- [private
|
|
-- {PROTECTED_ELEMENT_DECLARATION}]
|
|
-- end [protected_IDENTIFIER]
|
|
|
|
-- PROTECTED_ELEMENT_DECLARATION ::=
|
|
-- PROTECTED_OPERATION_DECLARATION
|
|
-- | COMPONENT_DECLARATION
|
|
|
|
-- The caller has already established the scope stack entry
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
function P_Protected_Definition return Node_Id is
|
|
Def_Node : Node_Id;
|
|
Item_Node : Node_Id;
|
|
Priv_Decls : List_Id;
|
|
Vis_Decls : List_Id;
|
|
|
|
begin
|
|
Def_Node := New_Node (N_Protected_Definition, Token_Ptr);
|
|
|
|
-- Get rid of active SIS entry from outer scope. This means we will
|
|
-- miss some nested cases, but it doesn't seem worth the effort. See
|
|
-- discussion in Par for further details
|
|
|
|
SIS_Entry_Active := False;
|
|
|
|
-- Loop to scan visible declarations (protected operation declarations)
|
|
|
|
Vis_Decls := New_List;
|
|
Set_Visible_Declarations (Def_Node, Vis_Decls);
|
|
|
|
-- Flag and discard all pragmas which cannot appear in the protected
|
|
-- definition. Note that certain pragmas are still allowed as long as
|
|
-- they apply to entries, entry families, or protected subprograms.
|
|
|
|
P_Pragmas_Opt (Vis_Decls);
|
|
|
|
loop
|
|
Item_Node := P_Protected_Operation_Declaration_Opt;
|
|
|
|
if Present (Item_Node) then
|
|
Append (Item_Node, Vis_Decls);
|
|
end if;
|
|
|
|
P_Pragmas_Opt (Vis_Decls);
|
|
|
|
exit when No (Item_Node);
|
|
end loop;
|
|
|
|
-- Deal with PRIVATE part (including graceful handling of multiple
|
|
-- PRIVATE parts).
|
|
|
|
Private_Loop : while Token = Tok_Private loop
|
|
Priv_Decls := Private_Declarations (Def_Node);
|
|
|
|
if Present (Priv_Decls) then
|
|
Error_Msg_SC ("duplicate private part");
|
|
else
|
|
Priv_Decls := New_List;
|
|
Set_Private_Declarations (Def_Node, Priv_Decls);
|
|
end if;
|
|
|
|
Scan; -- past PRIVATE
|
|
|
|
-- Flag and discard all pragmas which cannot appear in the protected
|
|
-- definition. Note that certain pragmas are still allowed as long as
|
|
-- they apply to entries, entry families, or protected subprograms.
|
|
|
|
P_Pragmas_Opt (Priv_Decls);
|
|
|
|
Declaration_Loop : loop
|
|
if Token = Tok_Identifier then
|
|
P_Component_Items (Priv_Decls);
|
|
P_Pragmas_Opt (Priv_Decls);
|
|
|
|
else
|
|
Item_Node := P_Protected_Operation_Declaration_Opt;
|
|
|
|
if Present (Item_Node) then
|
|
Append (Item_Node, Priv_Decls);
|
|
end if;
|
|
|
|
P_Pragmas_Opt (Priv_Decls);
|
|
|
|
exit Declaration_Loop when No (Item_Node);
|
|
end if;
|
|
end loop Declaration_Loop;
|
|
end loop Private_Loop;
|
|
|
|
End_Statements (Def_Node);
|
|
return Def_Node;
|
|
end P_Protected_Definition;
|
|
|
|
------------------------------------------
|
|
-- 9.4 Protected Operation Declaration --
|
|
------------------------------------------
|
|
|
|
-- PROTECTED_OPERATION_DECLARATION ::=
|
|
-- SUBPROGRAM_DECLARATION
|
|
-- | ENTRY_DECLARATION
|
|
-- | REPRESENTATION_CLAUSE
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
-- Note: a pragma can also be returned in this position
|
|
|
|
-- We are not currently permitting representation clauses to appear as
|
|
-- protected operation declarations, do we have to rethink this???
|
|
|
|
function P_Protected_Operation_Declaration_Opt return Node_Id is
|
|
L : List_Id;
|
|
P : Source_Ptr;
|
|
|
|
function P_Entry_Or_Subprogram_With_Indicator return Node_Id;
|
|
-- Ada 2005 (AI-397): Parse an entry or a subprogram with an overriding
|
|
-- indicator. The caller has checked that the initial token is NOT or
|
|
-- OVERRIDING.
|
|
|
|
------------------------------------------
|
|
-- P_Entry_Or_Subprogram_With_Indicator --
|
|
------------------------------------------
|
|
|
|
function P_Entry_Or_Subprogram_With_Indicator return Node_Id is
|
|
Decl : Node_Id := Error;
|
|
Is_Overriding : Boolean := False;
|
|
Not_Overriding : Boolean := False;
|
|
|
|
begin
|
|
if Token = Tok_Not then
|
|
Scan; -- past NOT
|
|
|
|
if Token = Tok_Overriding then
|
|
Scan; -- past OVERRIDING
|
|
Not_Overriding := True;
|
|
else
|
|
Error_Msg_SC -- CODEFIX
|
|
("OVERRIDING expected!");
|
|
end if;
|
|
|
|
else
|
|
Scan; -- past OVERRIDING
|
|
Is_Overriding := True;
|
|
end if;
|
|
|
|
if Is_Overriding or else Not_Overriding then
|
|
if Ada_Version < Ada_2005 then
|
|
Error_Msg_Ada_2005_Extension ("overriding indicator");
|
|
|
|
elsif Token = Tok_Entry then
|
|
Decl := P_Entry_Declaration;
|
|
|
|
Set_Must_Override (Decl, Is_Overriding);
|
|
Set_Must_Not_Override (Decl, Not_Overriding);
|
|
|
|
elsif Token = Tok_Function or else Token = Tok_Procedure then
|
|
Decl := P_Subprogram (Pf_Decl_Pexp);
|
|
|
|
Set_Must_Override (Specification (Decl), Is_Overriding);
|
|
Set_Must_Not_Override (Specification (Decl), Not_Overriding);
|
|
|
|
else
|
|
Error_Msg_SC -- CODEFIX
|
|
("ENTRY, FUNCTION or PROCEDURE expected!");
|
|
end if;
|
|
end if;
|
|
|
|
return Decl;
|
|
end P_Entry_Or_Subprogram_With_Indicator;
|
|
|
|
Result : Node_Id := Empty;
|
|
|
|
-- Start of processing for P_Protected_Operation_Declaration_Opt
|
|
|
|
begin
|
|
-- This loop runs more than once only when a junk declaration is skipped
|
|
|
|
loop
|
|
case Token is
|
|
when Tok_Pragma =>
|
|
Result := P_Pragma;
|
|
exit;
|
|
|
|
when Tok_Not
|
|
| Tok_Overriding
|
|
=>
|
|
Result := P_Entry_Or_Subprogram_With_Indicator;
|
|
exit;
|
|
|
|
when Tok_Entry =>
|
|
Result := P_Entry_Declaration;
|
|
exit;
|
|
|
|
when Tok_Function
|
|
| Tok_Procedure
|
|
=>
|
|
Result := P_Subprogram (Pf_Decl_Pexp);
|
|
exit;
|
|
|
|
when Tok_Identifier =>
|
|
L := New_List;
|
|
P := Token_Ptr;
|
|
Skip_Declaration (L);
|
|
|
|
if Nkind (First (L)) = N_Object_Declaration then
|
|
Error_Msg
|
|
("component must be declared in private part of " &
|
|
"protected type", P);
|
|
else
|
|
Error_Msg
|
|
("illegal declaration in protected definition", P);
|
|
end if;
|
|
-- Continue looping
|
|
|
|
when Tok_For =>
|
|
Error_Msg_SC
|
|
("representation clause not allowed in protected definition");
|
|
Resync_Past_Semicolon;
|
|
-- Continue looping
|
|
|
|
when others =>
|
|
if Token in Token_Class_Declk then
|
|
Error_Msg_SC ("illegal declaration in protected definition");
|
|
Resync_Past_Semicolon;
|
|
|
|
-- Return now to avoid cascaded messages if next declaration
|
|
-- is a valid component declaration.
|
|
|
|
Result := Error;
|
|
end if;
|
|
|
|
exit;
|
|
end case;
|
|
end loop;
|
|
|
|
if Nkind (Result) = N_Subprogram_Declaration
|
|
and then Nkind (Specification (Result)) =
|
|
N_Procedure_Specification
|
|
and then Null_Present (Specification (Result))
|
|
then
|
|
Error_Msg_N
|
|
("protected operation cannot be a null procedure",
|
|
Null_Statement (Specification (Result)));
|
|
end if;
|
|
|
|
return Result;
|
|
end P_Protected_Operation_Declaration_Opt;
|
|
|
|
-----------------------------------
|
|
-- 9.4 Protected Operation Item --
|
|
-----------------------------------
|
|
|
|
-- PROTECTED_OPERATION_ITEM ::=
|
|
-- SUBPROGRAM_DECLARATION
|
|
-- | SUBPROGRAM_BODY
|
|
-- | ENTRY_BODY
|
|
-- | REPRESENTATION_CLAUSE
|
|
|
|
-- This procedure parses and returns a list of protected operation items
|
|
|
|
-- We are not currently permitting representation clauses to appear
|
|
-- as protected operation items, do we have to rethink this???
|
|
|
|
function P_Protected_Operation_Items return List_Id is
|
|
Item_List : List_Id;
|
|
|
|
begin
|
|
Item_List := New_List;
|
|
|
|
loop
|
|
if Token = Tok_Entry or else Bad_Spelling_Of (Tok_Entry) then
|
|
Append (P_Entry_Body, Item_List);
|
|
|
|
-- If the operation starts with procedure, function, or an overriding
|
|
-- indicator ("overriding" or "not overriding"), parse a subprogram.
|
|
|
|
elsif Token = Tok_Function or else Bad_Spelling_Of (Tok_Function)
|
|
or else
|
|
Token = Tok_Procedure or else Bad_Spelling_Of (Tok_Procedure)
|
|
or else
|
|
Token = Tok_Overriding or else Bad_Spelling_Of (Tok_Overriding)
|
|
or else
|
|
Token = Tok_Not or else Bad_Spelling_Of (Tok_Not)
|
|
then
|
|
Append (P_Subprogram (Pf_Decl_Pbod_Pexp), Item_List);
|
|
|
|
elsif Token = Tok_Pragma or else Bad_Spelling_Of (Tok_Pragma) then
|
|
P_Pragmas_Opt (Item_List);
|
|
|
|
elsif Token = Tok_Private or else Bad_Spelling_Of (Tok_Private) then
|
|
Error_Msg_SC ("PRIVATE not allowed in protected body");
|
|
Scan; -- past PRIVATE
|
|
|
|
elsif Token = Tok_Identifier then
|
|
Error_Msg_SC ("all components must be declared in spec!");
|
|
Resync_Past_Semicolon;
|
|
|
|
elsif Token in Token_Class_Declk then
|
|
Error_Msg_SC ("declaration not allowed in protected body");
|
|
Resync_Past_Semicolon;
|
|
|
|
else
|
|
exit;
|
|
end if;
|
|
end loop;
|
|
|
|
return Item_List;
|
|
end P_Protected_Operation_Items;
|
|
|
|
------------------------------
|
|
-- 9.5.2 Entry Declaration --
|
|
------------------------------
|
|
|
|
-- ENTRY_DECLARATION ::=
|
|
-- [OVERRIDING_INDICATOR]
|
|
-- entry DEFINING_IDENTIFIER
|
|
-- [(DISCRETE_SUBTYPE_DEFINITION)] PARAMETER_PROFILE
|
|
-- [ASPECT_SPECIFICATIONS];
|
|
|
|
-- The caller has checked that the initial token is ENTRY, NOT or
|
|
-- OVERRIDING.
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
function P_Entry_Declaration return Node_Id is
|
|
Decl_Node : Node_Id;
|
|
Scan_State : Saved_Scan_State;
|
|
|
|
-- Flags for optional overriding indication. Two flags are needed,
|
|
-- to distinguish positive and negative overriding indicators from
|
|
-- the absence of any indicator.
|
|
|
|
Is_Overriding : Boolean := False;
|
|
Not_Overriding : Boolean := False;
|
|
|
|
begin
|
|
-- Ada 2005 (AI-397): Scan leading overriding indicator
|
|
|
|
if Token = Tok_Not then
|
|
Scan; -- past NOT
|
|
|
|
if Token = Tok_Overriding then
|
|
Scan; -- part OVERRIDING
|
|
Not_Overriding := True;
|
|
else
|
|
Error_Msg_SC -- CODEFIX
|
|
("OVERRIDING expected!");
|
|
end if;
|
|
|
|
elsif Token = Tok_Overriding then
|
|
Scan; -- part OVERRIDING
|
|
Is_Overriding := True;
|
|
end if;
|
|
|
|
if Is_Overriding or else Not_Overriding then
|
|
if Ada_Version < Ada_2005 then
|
|
Error_Msg_Ada_2005_Extension ("overriding indicator");
|
|
elsif Token /= Tok_Entry then
|
|
Error_Msg_SC -- CODEFIX
|
|
("ENTRY expected!");
|
|
end if;
|
|
end if;
|
|
|
|
Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
|
|
Scan; -- past ENTRY
|
|
|
|
Set_Defining_Identifier
|
|
(Decl_Node, P_Defining_Identifier (C_Left_Paren_Semicolon));
|
|
|
|
-- If left paren, could be (Discrete_Subtype_Definition) or Formal_Part
|
|
|
|
if Token = Tok_Left_Paren then
|
|
Scan; -- past (
|
|
|
|
-- If identifier after left paren, could still be either
|
|
|
|
if Token = Tok_Identifier then
|
|
Save_Scan_State (Scan_State); -- at Id
|
|
Scan; -- past Id
|
|
|
|
-- If comma or colon after Id, must be Formal_Part
|
|
|
|
if Token = Tok_Comma or else Token = Tok_Colon then
|
|
Restore_Scan_State (Scan_State); -- to Id
|
|
Set_Parameter_Specifications (Decl_Node, P_Formal_Part);
|
|
|
|
-- Else if Id without comma or colon, must be discrete subtype
|
|
-- defn
|
|
|
|
else
|
|
Restore_Scan_State (Scan_State); -- to Id
|
|
Set_Discrete_Subtype_Definition
|
|
(Decl_Node, P_Discrete_Subtype_Definition);
|
|
T_Right_Paren;
|
|
Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
|
|
end if;
|
|
|
|
-- If no Id, must be discrete subtype definition
|
|
|
|
else
|
|
Set_Discrete_Subtype_Definition
|
|
(Decl_Node, P_Discrete_Subtype_Definition);
|
|
T_Right_Paren;
|
|
Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
|
|
end if;
|
|
end if;
|
|
|
|
if Is_Overriding then
|
|
Set_Must_Override (Decl_Node);
|
|
elsif Not_Overriding then
|
|
Set_Must_Not_Override (Decl_Node);
|
|
end if;
|
|
|
|
-- Error recovery check for illegal return
|
|
|
|
if Token = Tok_Return then
|
|
Error_Msg_SC ("entry cannot have return value!");
|
|
Scan;
|
|
Discard_Junk_Node (P_Subtype_Indication);
|
|
end if;
|
|
|
|
-- Error recovery check for improper use of entry barrier in spec
|
|
|
|
if Token = Tok_When then
|
|
Error_Msg_SC ("barrier not allowed here (belongs in body)");
|
|
Scan; -- past WHEN;
|
|
Discard_Junk_Node (P_Expression_No_Right_Paren);
|
|
end if;
|
|
|
|
P_Aspect_Specifications (Decl_Node);
|
|
return Decl_Node;
|
|
|
|
exception
|
|
when Error_Resync =>
|
|
Resync_Past_Semicolon;
|
|
return Error;
|
|
end P_Entry_Declaration;
|
|
|
|
-----------------------------
|
|
-- 9.5.2 Accept Statement --
|
|
-----------------------------
|
|
|
|
-- ACCEPT_STATEMENT ::=
|
|
-- accept entry_DIRECT_NAME
|
|
-- [(ENTRY_INDEX)] PARAMETER_PROFILE [do
|
|
-- HANDLED_SEQUENCE_OF_STATEMENTS
|
|
-- end [entry_IDENTIFIER]];
|
|
|
|
-- The caller has checked that the initial token is ACCEPT
|
|
|
|
-- Error recovery: cannot raise Error_Resync. If an error occurs, the
|
|
-- scan is resynchronized past the next semicolon and control returns.
|
|
|
|
function P_Accept_Statement return Node_Id is
|
|
Scan_State : Saved_Scan_State;
|
|
Accept_Node : Node_Id;
|
|
Hand_Seq : Node_Id;
|
|
|
|
begin
|
|
Push_Scope_Stack;
|
|
Scopes (Scope.Last).Sloc := Token_Ptr;
|
|
Scopes (Scope.Last).Ecol := Start_Column;
|
|
|
|
Accept_Node := New_Node (N_Accept_Statement, Token_Ptr);
|
|
Scan; -- past ACCEPT
|
|
Scopes (Scope.Last).Labl := Token_Node;
|
|
Current_Node := Token_Node;
|
|
|
|
Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
|
|
|
|
-- Left paren could be (Entry_Index) or Formal_Part, determine which
|
|
|
|
if Token = Tok_Left_Paren then
|
|
Save_Scan_State (Scan_State); -- at left paren
|
|
Scan; -- past left paren
|
|
|
|
-- If first token after left paren not identifier, then Entry_Index
|
|
|
|
if Token /= Tok_Identifier then
|
|
Set_Entry_Index (Accept_Node, P_Expression);
|
|
T_Right_Paren;
|
|
Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
|
|
|
|
-- First token after left paren is identifier, could be either case
|
|
|
|
else -- Token = Tok_Identifier
|
|
Scan; -- past identifier
|
|
|
|
-- If identifier followed by comma or colon, must be Formal_Part
|
|
|
|
if Token = Tok_Comma or else Token = Tok_Colon then
|
|
Restore_Scan_State (Scan_State); -- to left paren
|
|
Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
|
|
|
|
-- If identifier not followed by comma/colon, must be entry index
|
|
|
|
else
|
|
Restore_Scan_State (Scan_State); -- to left paren
|
|
Scan; -- past left paren (again)
|
|
Set_Entry_Index (Accept_Node, P_Expression);
|
|
T_Right_Paren;
|
|
Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
|
|
end if;
|
|
end if;
|
|
end if;
|
|
|
|
-- Scan out DO if present
|
|
|
|
if Token = Tok_Do then
|
|
Scopes (Scope.Last).Etyp := E_Name;
|
|
Scopes (Scope.Last).Lreq := False;
|
|
Scan; -- past DO
|
|
Hand_Seq := P_Handled_Sequence_Of_Statements;
|
|
Set_Handled_Statement_Sequence (Accept_Node, Hand_Seq);
|
|
End_Statements (Handled_Statement_Sequence (Accept_Node));
|
|
|
|
-- Exception handlers not allowed in Ada 95 node
|
|
|
|
if Present (Exception_Handlers (Hand_Seq)) then
|
|
if Ada_Version = Ada_83 then
|
|
Error_Msg_N
|
|
("(Ada 83) exception handlers in accept not allowed",
|
|
First_Non_Pragma (Exception_Handlers (Hand_Seq)));
|
|
end if;
|
|
end if;
|
|
|
|
else
|
|
Pop_Scope_Stack; -- discard unused entry
|
|
TF_Semicolon;
|
|
end if;
|
|
|
|
return Accept_Node;
|
|
|
|
-- If error, resynchronize past semicolon
|
|
|
|
exception
|
|
when Error_Resync =>
|
|
Resync_Past_Semicolon;
|
|
Pop_Scope_Stack; -- discard unused entry
|
|
return Error;
|
|
end P_Accept_Statement;
|
|
|
|
------------------------
|
|
-- 9.5.2 Entry Index --
|
|
------------------------
|
|
|
|
-- Parsed by P_Expression (4.4)
|
|
|
|
--------------------------
|
|
-- 9.5.2 Entry Barrier --
|
|
--------------------------
|
|
|
|
-- ENTRY_BARRIER ::= when CONDITION
|
|
|
|
-- Error_Recovery: cannot raise Error_Resync
|
|
|
|
function P_Entry_Barrier return Node_Id is
|
|
Bnode : Node_Id;
|
|
|
|
begin
|
|
if Token = Tok_When then
|
|
Scan; -- past WHEN;
|
|
Bnode := P_Expression_No_Right_Paren;
|
|
|
|
if Token = Tok_Colon_Equal then
|
|
Error_Msg_SC -- CODEFIX
|
|
("|"":="" should be ""=""");
|
|
Scan;
|
|
Bnode := P_Expression_No_Right_Paren;
|
|
end if;
|
|
|
|
else
|
|
T_When; -- to give error message
|
|
Bnode := Error;
|
|
end if;
|
|
|
|
return Bnode;
|
|
end P_Entry_Barrier;
|
|
|
|
-----------------------
|
|
-- 9.5.2 Entry Body --
|
|
-----------------------
|
|
|
|
-- ENTRY_BODY ::=
|
|
-- entry DEFINING_IDENTIFIER ENTRY_BODY_FORMAL_PART
|
|
-- [ASPECT_SPECIFICATIONS] ENTRY_BARRIER
|
|
-- is
|
|
-- DECLARATIVE_PART
|
|
-- begin
|
|
-- HANDLED_SEQUENCE_OF_STATEMENTS
|
|
-- end [entry_IDENTIFIER];
|
|
|
|
-- The caller has checked that the initial token is ENTRY
|
|
|
|
-- Error_Recovery: cannot raise Error_Resync
|
|
|
|
function P_Entry_Body return Node_Id is
|
|
Dummy_Node : Node_Id;
|
|
Entry_Node : Node_Id;
|
|
Formal_Part_Node : Node_Id;
|
|
Name_Node : Node_Id;
|
|
|
|
begin
|
|
Push_Scope_Stack;
|
|
Entry_Node := New_Node (N_Entry_Body, Token_Ptr);
|
|
Scan; -- past ENTRY
|
|
|
|
Scopes (Scope.Last).Ecol := Start_Column;
|
|
Scopes (Scope.Last).Lreq := False;
|
|
Scopes (Scope.Last).Etyp := E_Name;
|
|
Scopes (Scope.Last).Sloc := Token_Ptr;
|
|
|
|
Name_Node := P_Defining_Identifier;
|
|
Set_Defining_Identifier (Entry_Node, Name_Node);
|
|
Scopes (Scope.Last).Labl := Name_Node;
|
|
Current_Node := Name_Node;
|
|
|
|
Formal_Part_Node := P_Entry_Body_Formal_Part;
|
|
Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node);
|
|
|
|
-- Ada 2012 (AI12-0169): Aspect specifications may appear on an entry
|
|
-- body immediately after the formal part. Do not parse the aspect
|
|
-- specifications directly because the "when" of the entry barrier may
|
|
-- be interpreted as a misused "with".
|
|
|
|
if Token = Tok_With then
|
|
P_Aspect_Specifications (Entry_Node, Semicolon => False);
|
|
end if;
|
|
|
|
Set_Condition (Formal_Part_Node, P_Entry_Barrier);
|
|
|
|
-- Detect an illegal placement of aspect specifications following the
|
|
-- entry barrier.
|
|
|
|
-- entry E ... when Barrier with Aspect is
|
|
|
|
if Token = Tok_With then
|
|
Error_Msg_SC ("aspect specifications must come before entry barrier");
|
|
|
|
-- Consume the illegal aspects to allow for parsing to continue
|
|
|
|
Dummy_Node := New_Node (N_Entry_Body, Sloc (Entry_Node));
|
|
P_Aspect_Specifications (Dummy_Node, Semicolon => False);
|
|
end if;
|
|
|
|
TF_Is;
|
|
Parse_Decls_Begin_End (Entry_Node);
|
|
|
|
return Entry_Node;
|
|
end P_Entry_Body;
|
|
|
|
-----------------------------------
|
|
-- 9.5.2 Entry Body Formal Part --
|
|
-----------------------------------
|
|
|
|
-- ENTRY_BODY_FORMAL_PART ::=
|
|
-- [(ENTRY_INDEX_SPECIFICATION)] [PARAMETER_PART]
|
|
|
|
-- Error_Recovery: cannot raise Error_Resync
|
|
|
|
function P_Entry_Body_Formal_Part return Node_Id is
|
|
Fpart_Node : Node_Id;
|
|
Scan_State : Saved_Scan_State;
|
|
|
|
begin
|
|
Fpart_Node := New_Node (N_Entry_Body_Formal_Part, Token_Ptr);
|
|
|
|
-- See if entry index specification present, and if so parse it
|
|
|
|
if Token = Tok_Left_Paren then
|
|
Save_Scan_State (Scan_State); -- at left paren
|
|
Scan; -- past left paren
|
|
|
|
if Token = Tok_For then
|
|
Set_Entry_Index_Specification
|
|
(Fpart_Node, P_Entry_Index_Specification);
|
|
T_Right_Paren;
|
|
else
|
|
Restore_Scan_State (Scan_State); -- to left paren
|
|
end if;
|
|
|
|
-- Check for (common?) case of left paren omitted before FOR. This
|
|
-- is a tricky case, because the corresponding missing left paren
|
|
-- can cause real havoc if a formal part is present which gets
|
|
-- treated as part of the discrete subtype definition of the
|
|
-- entry index specification, so just give error and resynchronize
|
|
|
|
elsif Token = Tok_For then
|
|
T_Left_Paren; -- to give error message
|
|
Resync_To_When;
|
|
end if;
|
|
|
|
Set_Parameter_Specifications (Fpart_Node, P_Parameter_Profile);
|
|
return Fpart_Node;
|
|
end P_Entry_Body_Formal_Part;
|
|
|
|
--------------------------------------
|
|
-- 9.5.2 Entry Index Specification --
|
|
--------------------------------------
|
|
|
|
-- ENTRY_INDEX_SPECIFICATION ::=
|
|
-- for DEFINING_IDENTIFIER in DISCRETE_SUBTYPE_DEFINITION
|
|
-- [ASPECT_SPECIFICATION]
|
|
|
|
-- Error recovery: can raise Error_Resync
|
|
|
|
function P_Entry_Index_Specification return Node_Id is
|
|
Iterator_Node : Node_Id;
|
|
|
|
begin
|
|
Iterator_Node := New_Node (N_Entry_Index_Specification, Token_Ptr);
|
|
T_For; -- past FOR
|
|
Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier (C_In));
|
|
T_In;
|
|
Set_Discrete_Subtype_Definition
|
|
(Iterator_Node, P_Discrete_Subtype_Definition);
|
|
|
|
if Token = Tok_With then
|
|
P_Aspect_Specifications (Iterator_Node, False);
|
|
end if;
|
|
|
|
return Iterator_Node;
|
|
end P_Entry_Index_Specification;
|
|
|
|
---------------------------------
|
|
-- 9.5.3 Entry Call Statement --
|
|
---------------------------------
|
|
|
|
-- Parsed by P_Name (4.1). Within a select, an entry call is parsed
|
|
-- by P_Select_Statement (9.7)
|
|
|
|
------------------------------
|
|
-- 9.5.4 Requeue Statement --
|
|
------------------------------
|
|
|
|
-- REQUEUE_STATEMENT ::= requeue entry_NAME [with abort];
|
|
|
|
-- The caller has checked that the initial token is requeue
|
|
|
|
-- Error recovery: can raise Error_Resync
|
|
|
|
function P_Requeue_Statement return Node_Id is
|
|
Requeue_Node : Node_Id;
|
|
|
|
begin
|
|
Requeue_Node := New_Node (N_Requeue_Statement, Token_Ptr);
|
|
Scan; -- past REQUEUE
|
|
Set_Name (Requeue_Node, P_Name);
|
|
|
|
if Token = Tok_With then
|
|
Scan; -- past WITH
|
|
T_Abort;
|
|
Set_Abort_Present (Requeue_Node, True);
|
|
end if;
|
|
|
|
TF_Semicolon;
|
|
return Requeue_Node;
|
|
end P_Requeue_Statement;
|
|
|
|
--------------------------
|
|
-- 9.6 Delay Statement --
|
|
--------------------------
|
|
|
|
-- DELAY_STATEMENT ::=
|
|
-- DELAY_UNTIL_STATEMENT
|
|
-- | DELAY_RELATIVE_STATEMENT
|
|
|
|
-- The caller has checked that the initial token is DELAY
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
function P_Delay_Statement return Node_Id is
|
|
begin
|
|
Scan; -- past DELAY
|
|
|
|
-- The following check for delay until misused in Ada 83 doesn't catch
|
|
-- all cases, but it's good enough to catch most of them.
|
|
|
|
if Token_Name = Name_Until then
|
|
Check_95_Keyword (Tok_Until, Tok_Left_Paren);
|
|
Check_95_Keyword (Tok_Until, Tok_Identifier);
|
|
end if;
|
|
|
|
if Token = Tok_Until then
|
|
return P_Delay_Until_Statement;
|
|
else
|
|
return P_Delay_Relative_Statement;
|
|
end if;
|
|
end P_Delay_Statement;
|
|
|
|
--------------------------------
|
|
-- 9.6 Delay Until Statement --
|
|
--------------------------------
|
|
|
|
-- DELAY_UNTIL_STATEMENT ::= delay until delay_EXPRESSION;
|
|
|
|
-- The caller has checked that the initial token is DELAY, scanned it
|
|
-- out and checked that the current token is UNTIL
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
function P_Delay_Until_Statement return Node_Id is
|
|
Delay_Node : Node_Id;
|
|
|
|
begin
|
|
Delay_Node := New_Node (N_Delay_Until_Statement, Prev_Token_Ptr);
|
|
Scan; -- past UNTIL
|
|
Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
|
|
TF_Semicolon;
|
|
return Delay_Node;
|
|
end P_Delay_Until_Statement;
|
|
|
|
-----------------------------------
|
|
-- 9.6 Delay Relative Statement --
|
|
-----------------------------------
|
|
|
|
-- DELAY_RELATIVE_STATEMENT ::= delay delay_EXPRESSION;
|
|
|
|
-- The caller has checked that the initial token is DELAY, scanned it
|
|
-- out and determined that the current token is not UNTIL
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
function P_Delay_Relative_Statement return Node_Id is
|
|
Delay_Node : Node_Id;
|
|
|
|
begin
|
|
Delay_Node := New_Node (N_Delay_Relative_Statement, Prev_Token_Ptr);
|
|
Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
|
|
Check_Simple_Expression_In_Ada_83 (Expression (Delay_Node));
|
|
TF_Semicolon;
|
|
return Delay_Node;
|
|
end P_Delay_Relative_Statement;
|
|
|
|
---------------------------
|
|
-- 9.7 Select Statement --
|
|
---------------------------
|
|
|
|
-- SELECT_STATEMENT ::=
|
|
-- SELECTIVE_ACCEPT
|
|
-- | TIMED_ENTRY_CALL
|
|
-- | CONDITIONAL_ENTRY_CALL
|
|
-- | ASYNCHRONOUS_SELECT
|
|
|
|
-- SELECTIVE_ACCEPT ::=
|
|
-- select
|
|
-- [GUARD]
|
|
-- SELECT_ALTERNATIVE
|
|
-- {or
|
|
-- [GUARD]
|
|
-- SELECT_ALTERNATIVE
|
|
-- [else
|
|
-- SEQUENCE_OF_STATEMENTS]
|
|
-- end select;
|
|
|
|
-- GUARD ::= when CONDITION =>
|
|
|
|
-- Note: the guard preceding a select alternative is included as part
|
|
-- of the node generated for a selective accept alternative.
|
|
|
|
-- SELECT_ALTERNATIVE ::=
|
|
-- ACCEPT_ALTERNATIVE
|
|
-- | DELAY_ALTERNATIVE
|
|
-- | TERMINATE_ALTERNATIVE
|
|
|
|
-- TIMED_ENTRY_CALL ::=
|
|
-- select
|
|
-- ENTRY_CALL_ALTERNATIVE
|
|
-- or
|
|
-- DELAY_ALTERNATIVE
|
|
-- end select;
|
|
|
|
-- CONDITIONAL_ENTRY_CALL ::=
|
|
-- select
|
|
-- ENTRY_CALL_ALTERNATIVE
|
|
-- else
|
|
-- SEQUENCE_OF_STATEMENTS
|
|
-- end select;
|
|
|
|
-- ENTRY_CALL_ALTERNATIVE ::=
|
|
-- ENTRY_CALL_STATEMENT [SEQUENCE_OF_STATEMENTS]
|
|
|
|
-- ASYNCHRONOUS_SELECT ::=
|
|
-- select
|
|
-- TRIGGERING_ALTERNATIVE
|
|
-- then abort
|
|
-- ABORTABLE_PART
|
|
-- end select;
|
|
|
|
-- TRIGGERING_ALTERNATIVE ::=
|
|
-- TRIGGERING_STATEMENT [SEQUENCE_OF_STATEMENTS]
|
|
|
|
-- TRIGGERING_STATEMENT ::= ENTRY_CALL_STATEMENT | DELAY_STATEMENT
|
|
|
|
-- The caller has checked that the initial token is SELECT
|
|
|
|
-- Error recovery: can raise Error_Resync
|
|
|
|
function P_Select_Statement return Node_Id is
|
|
Select_Node : Node_Id;
|
|
Select_Sloc : Source_Ptr;
|
|
Stmnt_Sloc : Source_Ptr;
|
|
Ecall_Node : Node_Id;
|
|
Alternative : Node_Id;
|
|
Select_Pragmas : List_Id;
|
|
Alt_Pragmas : List_Id;
|
|
Statement_List : List_Id;
|
|
Alt_List : List_Id;
|
|
Cond_Expr : Node_Id;
|
|
Delay_Stmnt : Node_Id;
|
|
|
|
begin
|
|
Push_Scope_Stack;
|
|
Scopes (Scope.Last).Etyp := E_Select;
|
|
Scopes (Scope.Last).Ecol := Start_Column;
|
|
Scopes (Scope.Last).Sloc := Token_Ptr;
|
|
Scopes (Scope.Last).Labl := Error;
|
|
|
|
Select_Sloc := Token_Ptr;
|
|
Scan; -- past SELECT
|
|
Stmnt_Sloc := Token_Ptr;
|
|
Select_Pragmas := P_Pragmas_Opt;
|
|
|
|
-- If first token after select is designator, then we have an entry
|
|
-- call, which must be the start of a conditional entry call, timed
|
|
-- entry call or asynchronous select
|
|
|
|
if Token in Token_Class_Desig then
|
|
|
|
-- Scan entry call statement
|
|
|
|
begin
|
|
Ecall_Node := P_Name;
|
|
|
|
-- ?? The following two clauses exactly parallel code in ch5
|
|
-- and should be combined sometime
|
|
|
|
if Nkind (Ecall_Node) = N_Indexed_Component then
|
|
declare
|
|
Prefix_Node : constant Node_Id := Prefix (Ecall_Node);
|
|
Exprs_Node : constant List_Id := Expressions (Ecall_Node);
|
|
|
|
begin
|
|
Change_Node (Ecall_Node, N_Procedure_Call_Statement);
|
|
Set_Name (Ecall_Node, Prefix_Node);
|
|
Set_Parameter_Associations (Ecall_Node, Exprs_Node);
|
|
end;
|
|
|
|
elsif Nkind (Ecall_Node) = N_Function_Call then
|
|
declare
|
|
Fname_Node : constant Node_Id := Name (Ecall_Node);
|
|
Params_List : constant List_Id :=
|
|
Parameter_Associations (Ecall_Node);
|
|
|
|
begin
|
|
Change_Node (Ecall_Node, N_Procedure_Call_Statement);
|
|
Set_Name (Ecall_Node, Fname_Node);
|
|
Set_Parameter_Associations (Ecall_Node, Params_List);
|
|
end;
|
|
|
|
elsif Nkind (Ecall_Node) = N_Identifier
|
|
or else Nkind (Ecall_Node) = N_Selected_Component
|
|
then
|
|
-- Case of a call to a parameterless entry
|
|
|
|
declare
|
|
C_Node : constant Node_Id :=
|
|
New_Node (N_Procedure_Call_Statement, Stmnt_Sloc);
|
|
begin
|
|
Set_Name (C_Node, Ecall_Node);
|
|
Set_Parameter_Associations (C_Node, No_List);
|
|
Ecall_Node := C_Node;
|
|
end;
|
|
end if;
|
|
|
|
TF_Semicolon;
|
|
|
|
exception
|
|
when Error_Resync =>
|
|
Resync_Past_Semicolon;
|
|
return Error;
|
|
end;
|
|
|
|
Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
|
|
|
|
-- OR follows, we have a timed entry call
|
|
|
|
if Token = Tok_Or then
|
|
Scan; -- past OR
|
|
Alt_Pragmas := P_Pragmas_Opt;
|
|
|
|
Select_Node := New_Node (N_Timed_Entry_Call, Select_Sloc);
|
|
Set_Entry_Call_Alternative (Select_Node,
|
|
Make_Entry_Call_Alternative (Stmnt_Sloc,
|
|
Entry_Call_Statement => Ecall_Node,
|
|
Pragmas_Before => Select_Pragmas,
|
|
Statements => Statement_List));
|
|
|
|
-- Only possibility is delay alternative. If we have anything
|
|
-- else, give message, and treat as conditional entry call.
|
|
|
|
if Token /= Tok_Delay then
|
|
Error_Msg_SC
|
|
("only allowed alternative in timed entry call is delay!");
|
|
Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
|
|
Set_Delay_Alternative (Select_Node, Error);
|
|
|
|
else
|
|
Set_Delay_Alternative (Select_Node, P_Delay_Alternative);
|
|
Set_Pragmas_Before
|
|
(Delay_Alternative (Select_Node), Alt_Pragmas);
|
|
end if;
|
|
|
|
-- ELSE follows, we have a conditional entry call
|
|
|
|
elsif Token = Tok_Else then
|
|
Scan; -- past ELSE
|
|
Select_Node := New_Node (N_Conditional_Entry_Call, Select_Sloc);
|
|
|
|
Set_Entry_Call_Alternative (Select_Node,
|
|
Make_Entry_Call_Alternative (Stmnt_Sloc,
|
|
Entry_Call_Statement => Ecall_Node,
|
|
Pragmas_Before => Select_Pragmas,
|
|
Statements => Statement_List));
|
|
|
|
Set_Else_Statements
|
|
(Select_Node, P_Sequence_Of_Statements (SS_Sreq));
|
|
|
|
-- Only remaining case is THEN ABORT (asynchronous select)
|
|
|
|
elsif Token = Tok_Abort then
|
|
Select_Node :=
|
|
Make_Asynchronous_Select (Select_Sloc,
|
|
Triggering_Alternative =>
|
|
Make_Triggering_Alternative (Stmnt_Sloc,
|
|
Triggering_Statement => Ecall_Node,
|
|
Pragmas_Before => Select_Pragmas,
|
|
Statements => Statement_List),
|
|
Abortable_Part => P_Abortable_Part);
|
|
|
|
-- Else error
|
|
|
|
else
|
|
if Ada_Version = Ada_83 then
|
|
Error_Msg_BC ("OR or ELSE expected");
|
|
else
|
|
Error_Msg_BC ("OR or ELSE or `THEN ABORT` expected");
|
|
end if;
|
|
|
|
Select_Node := Error;
|
|
end if;
|
|
|
|
End_Statements;
|
|
|
|
-- Here we have a selective accept or an asynchronous select (first
|
|
-- token after SELECT is other than a designator token).
|
|
|
|
else
|
|
-- If we have delay with no guard, could be asynchronous select
|
|
|
|
if Token = Tok_Delay then
|
|
Delay_Stmnt := P_Delay_Statement;
|
|
Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
|
|
|
|
-- Asynchronous select
|
|
|
|
if Token = Tok_Abort then
|
|
Select_Node :=
|
|
Make_Asynchronous_Select (Select_Sloc,
|
|
Triggering_Alternative =>
|
|
Make_Triggering_Alternative (Stmnt_Sloc,
|
|
Triggering_Statement => Delay_Stmnt,
|
|
Pragmas_Before => Select_Pragmas,
|
|
Statements => Statement_List),
|
|
Abortable_Part => P_Abortable_Part);
|
|
|
|
End_Statements;
|
|
return Select_Node;
|
|
|
|
-- Delay which was not an asynchronous select. Must be a selective
|
|
-- accept, and since at least one accept statement is required,
|
|
-- we must have at least one OR phrase present.
|
|
|
|
else
|
|
Alt_List := New_List (
|
|
Make_Delay_Alternative (Stmnt_Sloc,
|
|
Delay_Statement => Delay_Stmnt,
|
|
Pragmas_Before => Select_Pragmas,
|
|
Statements => Statement_List));
|
|
T_Or;
|
|
Alt_Pragmas := P_Pragmas_Opt;
|
|
end if;
|
|
|
|
-- If not a delay statement, then must be another possibility for
|
|
-- a selective accept alternative, or perhaps a guard is present
|
|
|
|
else
|
|
Alt_List := New_List;
|
|
Alt_Pragmas := Select_Pragmas;
|
|
end if;
|
|
|
|
Select_Node := New_Node (N_Selective_Accept, Select_Sloc);
|
|
Set_Select_Alternatives (Select_Node, Alt_List);
|
|
|
|
-- Scan out selective accept alternatives. On entry to this loop,
|
|
-- we are just past a SELECT or OR token, and any pragmas that
|
|
-- immediately follow the SELECT or OR are in Alt_Pragmas.
|
|
|
|
loop
|
|
if Token = Tok_When then
|
|
|
|
if Present (Alt_Pragmas) then
|
|
Error_Msg_SC ("pragmas may not precede guard");
|
|
end if;
|
|
|
|
Scan; -- past WHEN
|
|
Cond_Expr := P_Expression_No_Right_Paren;
|
|
T_Arrow;
|
|
Alt_Pragmas := P_Pragmas_Opt;
|
|
|
|
else
|
|
Cond_Expr := Empty;
|
|
end if;
|
|
|
|
if Token = Tok_Accept then
|
|
Alternative := P_Accept_Alternative;
|
|
|
|
-- Check for junk attempt at asynchronous select using
|
|
-- an Accept alternative as the triggering statement
|
|
|
|
if Token = Tok_Abort
|
|
and then Is_Empty_List (Alt_List)
|
|
and then No (Cond_Expr)
|
|
then
|
|
Error_Msg
|
|
("triggering statement must be entry call or delay",
|
|
Sloc (Alternative));
|
|
Scan; -- past junk ABORT
|
|
Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
|
|
End_Statements;
|
|
return Error;
|
|
end if;
|
|
|
|
elsif Token = Tok_Delay then
|
|
Alternative := P_Delay_Alternative;
|
|
|
|
elsif Token = Tok_Terminate then
|
|
Alternative := P_Terminate_Alternative;
|
|
|
|
else
|
|
Error_Msg_SC
|
|
("select alternative (ACCEPT, ABORT, DELAY) expected");
|
|
Alternative := Error;
|
|
|
|
if Token = Tok_Semicolon then
|
|
Scan; -- past junk semicolon
|
|
end if;
|
|
end if;
|
|
|
|
-- THEN ABORT at this stage is just junk
|
|
|
|
if Token = Tok_Abort then
|
|
Error_Msg_SP ("misplaced `THEN ABORT`");
|
|
Scan; -- past junk ABORT
|
|
Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
|
|
End_Statements;
|
|
return Error;
|
|
|
|
else
|
|
if Alternative /= Error then
|
|
Set_Condition (Alternative, Cond_Expr);
|
|
Set_Pragmas_Before (Alternative, Alt_Pragmas);
|
|
Append (Alternative, Alt_List);
|
|
end if;
|
|
|
|
exit when Token /= Tok_Or;
|
|
end if;
|
|
|
|
T_Or;
|
|
Alt_Pragmas := P_Pragmas_Opt;
|
|
end loop;
|
|
|
|
if Token = Tok_Else then
|
|
Scan; -- past ELSE
|
|
Set_Else_Statements
|
|
(Select_Node, P_Sequence_Of_Statements (SS_Ortm_Sreq));
|
|
|
|
if Token = Tok_Or then
|
|
Error_Msg_SC ("select alternative cannot follow else part!");
|
|
end if;
|
|
end if;
|
|
|
|
End_Statements;
|
|
end if;
|
|
|
|
return Select_Node;
|
|
end P_Select_Statement;
|
|
|
|
-----------------------------
|
|
-- 9.7.1 Selective Accept --
|
|
-----------------------------
|
|
|
|
-- Parsed by P_Select_Statement (9.7)
|
|
|
|
------------------
|
|
-- 9.7.1 Guard --
|
|
------------------
|
|
|
|
-- Parsed by P_Select_Statement (9.7)
|
|
|
|
-------------------------------
|
|
-- 9.7.1 Select Alternative --
|
|
-------------------------------
|
|
|
|
-- SELECT_ALTERNATIVE ::=
|
|
-- ACCEPT_ALTERNATIVE
|
|
-- | DELAY_ALTERNATIVE
|
|
-- | TERMINATE_ALTERNATIVE
|
|
|
|
-- Note: the guard preceding a select alternative is included as part
|
|
-- of the node generated for a selective accept alternative.
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
-------------------------------
|
|
-- 9.7.1 Accept Alternative --
|
|
-------------------------------
|
|
|
|
-- ACCEPT_ALTERNATIVE ::=
|
|
-- ACCEPT_STATEMENT [SEQUENCE_OF_STATEMENTS]
|
|
|
|
-- Error_Recovery: Cannot raise Error_Resync
|
|
|
|
-- Note: the caller is responsible for setting the Pragmas_Before
|
|
-- field of the returned N_Terminate_Alternative node.
|
|
|
|
function P_Accept_Alternative return Node_Id is
|
|
Accept_Alt_Node : Node_Id;
|
|
|
|
begin
|
|
Accept_Alt_Node := New_Node (N_Accept_Alternative, Token_Ptr);
|
|
Set_Accept_Statement (Accept_Alt_Node, P_Accept_Statement);
|
|
|
|
-- Note: the reason that we accept THEN ABORT as a terminator for
|
|
-- the sequence of statements is for error recovery which allows
|
|
-- for misuse of an accept statement as a triggering statement.
|
|
|
|
Set_Statements
|
|
(Accept_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
|
|
return Accept_Alt_Node;
|
|
end P_Accept_Alternative;
|
|
|
|
------------------------------
|
|
-- 9.7.1 Delay Alternative --
|
|
------------------------------
|
|
|
|
-- DELAY_ALTERNATIVE ::=
|
|
-- DELAY_STATEMENT [SEQUENCE_OF_STATEMENTS]
|
|
|
|
-- Error_Recovery: Cannot raise Error_Resync
|
|
|
|
-- Note: the caller is responsible for setting the Pragmas_Before
|
|
-- field of the returned N_Terminate_Alternative node.
|
|
|
|
function P_Delay_Alternative return Node_Id is
|
|
Delay_Alt_Node : Node_Id;
|
|
|
|
begin
|
|
Delay_Alt_Node := New_Node (N_Delay_Alternative, Token_Ptr);
|
|
Set_Delay_Statement (Delay_Alt_Node, P_Delay_Statement);
|
|
|
|
-- Note: the reason that we accept THEN ABORT as a terminator for
|
|
-- the sequence of statements is for error recovery which allows
|
|
-- for misuse of an accept statement as a triggering statement.
|
|
|
|
Set_Statements
|
|
(Delay_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
|
|
return Delay_Alt_Node;
|
|
end P_Delay_Alternative;
|
|
|
|
----------------------------------
|
|
-- 9.7.1 Terminate Alternative --
|
|
----------------------------------
|
|
|
|
-- TERMINATE_ALTERNATIVE ::= terminate;
|
|
|
|
-- Error_Recovery: Cannot raise Error_Resync
|
|
|
|
-- Note: the caller is responsible for setting the Pragmas_Before
|
|
-- field of the returned N_Terminate_Alternative node.
|
|
|
|
function P_Terminate_Alternative return Node_Id is
|
|
Terminate_Alt_Node : Node_Id;
|
|
|
|
begin
|
|
Terminate_Alt_Node := New_Node (N_Terminate_Alternative, Token_Ptr);
|
|
Scan; -- past TERMINATE
|
|
TF_Semicolon;
|
|
|
|
-- For all other select alternatives, the sequence of statements
|
|
-- after the alternative statement will swallow up any pragmas
|
|
-- coming in this position. But the terminate alternative has no
|
|
-- sequence of statements, so the pragmas here must be treated
|
|
-- specially.
|
|
|
|
Set_Pragmas_After (Terminate_Alt_Node, P_Pragmas_Opt);
|
|
return Terminate_Alt_Node;
|
|
end P_Terminate_Alternative;
|
|
|
|
-----------------------------
|
|
-- 9.7.2 Timed Entry Call --
|
|
-----------------------------
|
|
|
|
-- Parsed by P_Select_Statement (9.7)
|
|
|
|
-----------------------------------
|
|
-- 9.7.2 Entry Call Alternative --
|
|
-----------------------------------
|
|
|
|
-- Parsed by P_Select_Statement (9.7)
|
|
|
|
-----------------------------------
|
|
-- 9.7.3 Conditional Entry Call --
|
|
-----------------------------------
|
|
|
|
-- Parsed by P_Select_Statement (9.7)
|
|
|
|
--------------------------------
|
|
-- 9.7.4 Asynchronous Select --
|
|
--------------------------------
|
|
|
|
-- Parsed by P_Select_Statement (9.7)
|
|
|
|
-----------------------------------
|
|
-- 9.7.4 Triggering Alternative --
|
|
-----------------------------------
|
|
|
|
-- Parsed by P_Select_Statement (9.7)
|
|
|
|
---------------------------------
|
|
-- 9.7.4 Triggering Statement --
|
|
---------------------------------
|
|
|
|
-- Parsed by P_Select_Statement (9.7)
|
|
|
|
---------------------------
|
|
-- 9.7.4 Abortable Part --
|
|
---------------------------
|
|
|
|
-- ABORTABLE_PART ::= SEQUENCE_OF_STATEMENTS
|
|
|
|
-- The caller has verified that THEN ABORT is present, and Token is
|
|
-- pointing to the ABORT on entry (or if not, then we have an error)
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
function P_Abortable_Part return Node_Id is
|
|
Abortable_Part_Node : Node_Id;
|
|
|
|
begin
|
|
Abortable_Part_Node := New_Node (N_Abortable_Part, Token_Ptr);
|
|
T_Abort; -- scan past ABORT
|
|
|
|
if Ada_Version = Ada_83 then
|
|
Error_Msg_SP ("(Ada 83) asynchronous select not allowed!");
|
|
end if;
|
|
|
|
Set_Statements (Abortable_Part_Node, P_Sequence_Of_Statements (SS_Sreq));
|
|
return Abortable_Part_Node;
|
|
end P_Abortable_Part;
|
|
|
|
--------------------------
|
|
-- 9.8 Abort Statement --
|
|
--------------------------
|
|
|
|
-- ABORT_STATEMENT ::= abort task_NAME {, task_NAME};
|
|
|
|
-- The caller has checked that the initial token is ABORT
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
function P_Abort_Statement return Node_Id is
|
|
Abort_Node : Node_Id;
|
|
|
|
begin
|
|
Abort_Node := New_Node (N_Abort_Statement, Token_Ptr);
|
|
Scan; -- past ABORT
|
|
Set_Names (Abort_Node, New_List);
|
|
|
|
loop
|
|
Append (P_Name, Names (Abort_Node));
|
|
exit when Token /= Tok_Comma;
|
|
Scan; -- past comma
|
|
end loop;
|
|
|
|
TF_Semicolon;
|
|
return Abort_Node;
|
|
end P_Abort_Statement;
|
|
|
|
end Ch9;
|