pragma Style_Checks (All_Checks);
separate (Par)
package body Ch9 is
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_Definition return Node_Id;
function P_Task_Items return List_Id;
function P_Task return Node_Id is
Name_Node : Node_Id;
Task_Node : Node_Id;
Task_Sloc : Source_Ptr;
begin
Push_Scope_Stack;
Scope.Table (Scope.Last).Etyp := E_Name;
Scope.Table (Scope.Last).Ecol := Start_Column;
Scope.Table (Scope.Last).Sloc := Token_Ptr;
Scope.Table (Scope.Last).Lreq := False;
Task_Sloc := Prev_Token_Ptr;
if Token = Tok_Body then
Scan; Name_Node := P_Defining_Identifier;
Scope.Table (Scope.Last).Labl := 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;
TF_Is;
if Token = Tok_Separate then
Scan; Task_Node := New_Node (N_Task_Body_Stub, Task_Sloc);
Set_Defining_Identifier (Task_Node, Name_Node);
TF_Semicolon;
Pop_Scope_Stack;
else
Task_Node := New_Node (N_Task_Body, Task_Sloc);
Set_Defining_Identifier (Task_Node, Name_Node);
Parse_Decls_Begin_End (Task_Node);
end if;
return Task_Node;
else
if Token = Tok_Type then
Scan; Task_Node := New_Node (N_Task_Type_Declaration, Task_Sloc);
Name_Node := P_Defining_Identifier;
Set_Defining_Identifier (Task_Node, Name_Node);
Scope.Table (Scope.Last).Labl := 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;
Set_Defining_Identifier (Task_Node, Name_Node);
Scope.Table (Scope.Last).Labl := 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;
if Token = Tok_Semicolon then
Scan;
if Token = Tok_Entry then
Error_Msg_SP (""";"" should be IS");
Set_Task_Definition (Task_Node, P_Task_Definition);
else
Pop_Scope_Stack; end if;
else
TF_Is; Set_Task_Definition (Task_Node, P_Task_Definition);
end if;
return Task_Node;
end if;
end P_Task;
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; Set_Private_Declarations (Def_Node, P_Task_Items);
while Token = Tok_Private loop
Error_Msg_SC ("Only one private part allowed per task");
Scan; Append_List (P_Task_Items, Private_Declarations (Def_Node));
end loop;
end if;
End_Statements (Def_Node);
return Def_Node;
end P_Task_Definition;
function P_Task_Items return List_Id is
Items : List_Id;
Item_Node : Node_Id;
Decl_Sloc : Source_Ptr;
begin
SIS_Entry_Active := False;
Items := New_List;
Decl_Loop : loop
Decl_Sloc := Token_Ptr;
if Token = Tok_Pragma then
Append (P_Pragma, Items);
elsif Token = Tok_Entry then
Append (P_Entry_Declaration, Items);
elsif Token = Tok_For then
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;
function P_Protected return Node_Id is
Name_Node : Node_Id;
Protected_Node : Node_Id;
Protected_Sloc : Source_Ptr;
begin
Push_Scope_Stack;
Scope.Table (Scope.Last).Etyp := E_Name;
Scope.Table (Scope.Last).Ecol := Start_Column;
Scope.Table (Scope.Last).Lreq := False;
Protected_Sloc := Prev_Token_Ptr;
if Token = Tok_Body then
Scan; Name_Node := P_Defining_Identifier;
Scope.Table (Scope.Last).Labl := 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;
TF_Is;
if Token = Tok_Separate then
Scan; Protected_Node := New_Node (N_Protected_Body_Stub, Protected_Sloc);
Set_Defining_Identifier (Protected_Node, Name_Node);
TF_Semicolon;
Pop_Scope_Stack;
else
Protected_Node := New_Node (N_Protected_Body, Protected_Sloc);
Set_Defining_Identifier (Protected_Node, Name_Node);
Set_Declarations (Protected_Node, P_Protected_Operation_Items);
End_Statements (Protected_Node);
end if;
return Protected_Node;
else
if Token = Tok_Type then
Scan; Protected_Node :=
New_Node (N_Protected_Type_Declaration, Protected_Sloc);
Name_Node := P_Defining_Identifier;
Set_Defining_Identifier (Protected_Node, Name_Node);
Scope.Table (Scope.Last).Labl := 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;
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;
Scope.Table (Scope.Last).Labl := Name_Node;
end if;
T_Is;
Set_Protected_Definition (Protected_Node, P_Protected_Definition);
return Protected_Node;
end if;
end P_Protected;
function P_Protected_Definition return Node_Id is
Def_Node : Node_Id;
Item_Node : Node_Id;
begin
Def_Node := New_Node (N_Protected_Definition, Token_Ptr);
SIS_Entry_Active := False;
Set_Visible_Declarations (Def_Node, New_List);
loop
Item_Node := P_Protected_Operation_Declaration_Opt;
exit when No (Item_Node);
Append (Item_Node, Visible_Declarations (Def_Node));
end loop;
Private_Loop : while Token = Tok_Private loop
if No (Private_Declarations (Def_Node)) then
Set_Private_Declarations (Def_Node, New_List);
else
Error_Msg_SC ("duplicate private part");
end if;
Scan;
Declaration_Loop : loop
if Token = Tok_Identifier then
P_Component_Items (Private_Declarations (Def_Node));
else
Item_Node := P_Protected_Operation_Declaration_Opt;
exit Declaration_Loop when No (Item_Node);
Append (Item_Node, Private_Declarations (Def_Node));
end if;
end loop Declaration_Loop;
end loop Private_Loop;
End_Statements (Def_Node);
return Def_Node;
end P_Protected_Definition;
function P_Protected_Operation_Declaration_Opt return Node_Id is
L : List_Id;
P : Source_Ptr;
begin
loop
if Token = Tok_Pragma then
return P_Pragma;
elsif Token = Tok_Entry then
return P_Entry_Declaration;
elsif Token = Tok_Function or else Token = Tok_Procedure then
return P_Subprogram (Pf_Decl);
elsif Token = Tok_Identifier then
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;
elsif Token in Token_Class_Declk then
Error_Msg_SC ("illegal declaration in protected definition");
Resync_Past_Semicolon;
return Error;
elsif Token = Tok_For then
Error_Msg_SC
("representation clause not allowed in protected definition");
Resync_Past_Semicolon;
else
return Empty;
end if;
end loop;
end P_Protected_Operation_Declaration_Opt;
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);
elsif Token = Tok_Function or else Bad_Spelling_Of (Tok_Function)
or else
Token = Tok_Procedure or else Bad_Spelling_Of (Tok_Procedure)
then
Append (P_Subprogram (Pf_Decl_Pbod), 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;
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 ("this declaration not allowed in protected body");
Resync_Past_Semicolon;
else
exit;
end if;
end loop;
return Item_List;
end P_Protected_Operation_Items;
function P_Entry_Declaration return Node_Id is
Decl_Node : Node_Id;
Scan_State : Saved_Scan_State;
begin
Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
Scan;
Set_Defining_Identifier (Decl_Node, P_Defining_Identifier);
if Token = Tok_Left_Paren then
Scan;
if Token = Tok_Identifier then
Save_Scan_State (Scan_State); Scan;
if Token = Tok_Comma or else Token = Tok_Colon then
Restore_Scan_State (Scan_State); Set_Parameter_Specifications (Decl_Node, P_Formal_Part);
else
Restore_Scan_State (Scan_State); Set_Discrete_Subtype_Definition
(Decl_Node, P_Discrete_Subtype_Definition);
T_Right_Paren;
Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
end if;
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 Token = Tok_Return then
Error_Msg_SC ("entry cannot have return value!");
Scan;
Discard_Junk_Node (P_Subtype_Indication);
end if;
if Token = Tok_When then
Error_Msg_SC ("barrier not allowed here (belongs in body)");
Scan; Discard_Junk_Node (P_Expression_No_Right_Paren);
end if;
TF_Semicolon;
return Decl_Node;
end P_Entry_Declaration;
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;
Scope.Table (Scope.Last).Sloc := Token_Ptr;
Scope.Table (Scope.Last).Ecol := Start_Column;
Accept_Node := New_Node (N_Accept_Statement, Token_Ptr);
Scan; Scope.Table (Scope.Last).Labl := Token_Node;
Set_Entry_Direct_Name (Accept_Node, P_Identifier);
if Token = Tok_Left_Paren then
Save_Scan_State (Scan_State); Scan;
if Token /= Tok_Identifier then
Set_Entry_Index (Accept_Node, P_Expression);
T_Right_Paren;
Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
else Scan;
if Token = Tok_Comma or else Token = Tok_Colon then
Restore_Scan_State (Scan_State); Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
else
Restore_Scan_State (Scan_State); Scan; Set_Entry_Index (Accept_Node, P_Expression);
T_Right_Paren;
Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
end if;
end if;
end if;
if Token = Tok_Do then
Scope.Table (Scope.Last).Etyp := E_Name;
Scope.Table (Scope.Last).Lreq := False;
Scan; Hand_Seq := P_Handled_Sequence_Of_Statements;
Set_Handled_Statement_Sequence (Accept_Node, Hand_Seq);
End_Statements (Handled_Statement_Sequence (Accept_Node));
if Present (Exception_Handlers (Hand_Seq)) then
if 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; TF_Semicolon;
end if;
return Accept_Node;
exception
when Error_Resync =>
Resync_Past_Semicolon;
return Error;
end P_Accept_Statement;
function P_Entry_Body return Node_Id is
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;
Scope.Table (Scope.Last).Ecol := Start_Column;
Scope.Table (Scope.Last).Lreq := False;
Scope.Table (Scope.Last).Etyp := E_Name;
Name_Node := P_Defining_Identifier;
Set_Defining_Identifier (Entry_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node;
Formal_Part_Node := P_Entry_Body_Formal_Part;
Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node);
Set_Condition (Formal_Part_Node, P_Entry_Barrier);
Parse_Decls_Begin_End (Entry_Node);
return Entry_Node;
end P_Entry_Body;
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);
if Token = Tok_Left_Paren then
Save_Scan_State (Scan_State); Scan;
if Token = Tok_For then
Set_Entry_Index_Specification
(Fpart_Node, P_Entry_Index_Specification);
T_Right_Paren;
else
Restore_Scan_State (Scan_State); end if;
elsif Token = Tok_For then
T_Left_Paren; Resync_To_When;
end if;
Set_Parameter_Specifications (Fpart_Node, P_Parameter_Profile);
return Fpart_Node;
end P_Entry_Body_Formal_Part;
function P_Entry_Barrier return Node_Id is
Bnode : Node_Id;
begin
if Token = Tok_When then
Scan; Bnode := P_Expression_No_Right_Paren;
if Token = Tok_Colon_Equal then
Error_Msg_SC (""":="" should be ""=""");
Scan;
Bnode := P_Expression_No_Right_Paren;
end if;
else
T_When; Bnode := Error;
end if;
TF_Is;
return Bnode;
end P_Entry_Barrier;
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; Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier);
T_In;
Set_Discrete_Subtype_Definition
(Iterator_Node, P_Discrete_Subtype_Definition);
return Iterator_Node;
end P_Entry_Index_Specification;
function P_Requeue_Statement return Node_Id is
Requeue_Node : Node_Id;
begin
Requeue_Node := New_Node (N_Requeue_Statement, Token_Ptr);
Scan; Set_Name (Requeue_Node, P_Name);
if Token = Tok_With then
Scan; T_Abort;
Set_Abort_Present (Requeue_Node, True);
end if;
TF_Semicolon;
return Requeue_Node;
end P_Requeue_Statement;
function P_Delay_Statement return Node_Id is
begin
Scan;
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;
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; Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
TF_Semicolon;
return Delay_Node;
end P_Delay_Until_Statement;
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;
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;
Scope.Table (Scope.Last).Etyp := E_Select;
Scope.Table (Scope.Last).Ecol := Start_Column;
Scope.Table (Scope.Last).Sloc := Token_Ptr;
Scope.Table (Scope.Last).Labl := Error;
Select_Sloc := Token_Ptr;
Scan; Stmnt_Sloc := Token_Ptr;
Select_Pragmas := P_Pragmas_Opt;
if Token in Token_Class_Desig then
begin
Ecall_Node := P_Name;
if Nkind (Ecall_Node) = N_Indexed_Component then
declare
Prefix_Node : Node_Id := Prefix (Ecall_Node);
Exprs_Node : 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 : Node_Id := Name (Ecall_Node);
Params_List : 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
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);
if Token = Tok_Or then
Scan; 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));
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;
elsif Token = Tok_Else then
Scan; 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));
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
if 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;
else
if Token = Tok_Delay then
Delay_Stmnt := P_Delay_Statement;
Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
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;
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;
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);
loop
if Token = Tok_When then
if Present (Alt_Pragmas) then
Error_Msg_SC ("pragmas may not precede guard");
end if;
Scan; 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;
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; 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; end if;
end if;
if Token = Tok_Abort then
Error_Msg_SP ("misplaced `THEN ABORT`");
Scan; 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; 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;
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);
Set_Statements
(Accept_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
return Accept_Alt_Node;
end P_Accept_Alternative;
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);
Set_Statements
(Delay_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
return Delay_Alt_Node;
end P_Delay_Alternative;
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; TF_Semicolon;
Set_Pragmas_After (Terminate_Alt_Node, P_Pragmas_Opt);
return Terminate_Alt_Node;
end P_Terminate_Alternative;
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;
if 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;
function P_Abort_Statement return Node_Id is
Abort_Node : Node_Id;
begin
Abort_Node := New_Node (N_Abort_Statement, Token_Ptr);
Scan; Set_Names (Abort_Node, New_List);
loop
Append (P_Name, Names (Abort_Node));
exit when Token /= Tok_Comma;
Scan; end loop;
TF_Semicolon;
return Abort_Node;
end P_Abort_Statement;
end Ch9;