1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 pragma Style_Checks (All_Checks);
27 -- Turn off subprogram body ordering check. Subprograms are in order by RM
28 -- section rather than alphabetical.
33 -- Local subprograms, used only in this chapter
35 function P_Accept_Alternative return Node_Id;
36 function P_Delay_Alternative return Node_Id;
37 function P_Delay_Relative_Statement return Node_Id;
38 function P_Delay_Until_Statement return Node_Id;
39 function P_Entry_Barrier return Node_Id;
40 function P_Entry_Body_Formal_Part return Node_Id;
41 function P_Entry_Declaration return Node_Id;
42 function P_Entry_Index_Specification return Node_Id;
43 function P_Protected_Definition return Node_Id;
44 function P_Protected_Operation_Declaration_Opt return Node_Id;
45 function P_Protected_Operation_Items return List_Id;
46 function P_Task_Definition return Node_Id;
47 function P_Task_Items return List_Id;
49 -----------------------------
50 -- 9.1 Task (also 10.1.3) --
51 -----------------------------
53 -- TASK_TYPE_DECLARATION ::=
54 -- task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
55 -- [is [new INTERFACE_LIST with] TASK_DEFINITION];
57 -- SINGLE_TASK_DECLARATION ::=
58 -- task DEFINING_IDENTIFIER
59 -- [is [new INTERFACE_LIST with] TASK_DEFINITION];
62 -- task body DEFINING_IDENTIFIER is
65 -- HANDLED_SEQUENCE_OF_STATEMENTS
66 -- end [task_IDENTIFIER]
69 -- task body DEFINING_IDENTIFIER is separate;
71 -- This routine scans out a task declaration, task body, or task stub
73 -- The caller has checked that the initial token is TASK and scanned
74 -- past it, so that Token is set to the token after TASK
76 -- Error recovery: cannot raise Error_Resync
78 function P_Task return Node_Id is
81 Task_Sloc : Source_Ptr;
85 Scope.Table (Scope.Last).Etyp := E_Name;
86 Scope.Table (Scope.Last).Ecol := Start_Column;
87 Scope.Table (Scope.Last).Sloc := Token_Ptr;
88 Scope.Table (Scope.Last).Lreq := False;
89 Task_Sloc := Prev_Token_Ptr;
91 if Token = Tok_Body then
93 Name_Node := P_Defining_Identifier (C_Is);
94 Scope.Table (Scope.Last).Labl := Name_Node;
96 if Token = Tok_Left_Paren then
97 Error_Msg_SC ("discriminant part not allowed in task body");
98 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
105 if Token = Tok_Separate then
106 Scan; -- past SEPARATE
107 Task_Node := New_Node (N_Task_Body_Stub, Task_Sloc);
108 Set_Defining_Identifier (Task_Node, Name_Node);
110 Pop_Scope_Stack; -- remove unused entry
115 Task_Node := New_Node (N_Task_Body, Task_Sloc);
116 Set_Defining_Identifier (Task_Node, Name_Node);
117 Parse_Decls_Begin_End (Task_Node);
122 -- Otherwise we must have a task declaration
125 if Token = Tok_Type then
127 Task_Node := New_Node (N_Task_Type_Declaration, Task_Sloc);
128 Name_Node := P_Defining_Identifier;
129 Set_Defining_Identifier (Task_Node, Name_Node);
130 Scope.Table (Scope.Last).Labl := Name_Node;
131 Set_Discriminant_Specifications
132 (Task_Node, P_Known_Discriminant_Part_Opt);
135 Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc);
136 Name_Node := P_Defining_Identifier (C_Is);
137 Set_Defining_Identifier (Task_Node, Name_Node);
138 Scope.Table (Scope.Last).Labl := Name_Node;
140 if Token = Tok_Left_Paren then
141 Error_Msg_SC ("discriminant part not allowed for single task");
142 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
146 -- Parse optional task definition. Note that P_Task_Definition scans
147 -- out the semicolon as well as the task definition itself.
149 if Token = Tok_Semicolon then
151 -- A little check, if the next token after semicolon is
152 -- Entry, then surely the semicolon should really be IS
154 Scan; -- past semicolon
156 if Token = Tok_Entry then
157 Error_Msg_SP ("|"";"" should be IS");
158 Set_Task_Definition (Task_Node, P_Task_Definition);
160 Pop_Scope_Stack; -- Remove unused entry
163 TF_Is; -- must have IS if no semicolon
167 if Token = Tok_New then
170 if Ada_Version < Ada_05 then
171 Error_Msg_SP ("task interface is an Ada 2005 extension");
172 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
175 Set_Interface_List (Task_Node, New_List);
178 Append (P_Qualified_Simple_Name, Interface_List (Task_Node));
179 exit when Token /= Tok_And;
183 if Token /= Tok_With then
184 Error_Msg_SC ("WITH expected");
189 if Token = Tok_Private then
191 ("PRIVATE not allowed in task type declaration");
195 Set_Task_Definition (Task_Node, P_Task_Definition);
202 --------------------------------
203 -- 9.1 Task Type Declaration --
204 --------------------------------
206 -- Parsed by P_Task (9.1)
208 ----------------------------------
209 -- 9.1 Single Task Declaration --
210 ----------------------------------
212 -- Parsed by P_Task (9.1)
214 --------------------------
215 -- 9.1 Task Definition --
216 --------------------------
218 -- TASK_DEFINITION ::=
222 -- end [task_IDENTIFIER];
224 -- The caller has already made the scope stack entry
226 -- Note: there is a small deviation from official syntax here in that we
227 -- regard the semicolon after end as part of the Task_Definition, and in
228 -- the official syntax, it's part of the enclosing declaration. The reason
229 -- for this deviation is that otherwise the end processing would have to
230 -- be special cased, which would be a nuisance!
232 -- Error recovery: cannot raise Error_Resync
234 function P_Task_Definition return Node_Id is
238 Def_Node := New_Node (N_Task_Definition, Token_Ptr);
239 Set_Visible_Declarations (Def_Node, P_Task_Items);
241 if Token = Tok_Private then
242 Scan; -- past PRIVATE
243 Set_Private_Declarations (Def_Node, P_Task_Items);
245 -- Deal gracefully with multiple PRIVATE parts
247 while Token = Tok_Private loop
248 Error_Msg_SC ("only one private part allowed per task");
249 Scan; -- past PRIVATE
250 Append_List (P_Task_Items, Private_Declarations (Def_Node));
254 End_Statements (Def_Node);
256 end P_Task_Definition;
262 -- TASK_ITEM ::= ENTRY_DECLARATION | REPRESENTATION_CLAUSE
264 -- This subprogram scans a (possibly empty) list of task items and pragmas
266 -- Error recovery: cannot raise Error_Resync
268 -- Note: a pragma can also be returned in this position
270 function P_Task_Items return List_Id is
273 Decl_Sloc : Source_Ptr;
276 -- Get rid of active SIS entry from outer scope. This means we will
277 -- miss some nested cases, but it doesn't seem worth the effort. See
278 -- discussion in Par for further details
280 SIS_Entry_Active := False;
282 -- Loop to scan out task items
287 Decl_Sloc := Token_Ptr;
289 if Token = Tok_Pragma then
290 Append (P_Pragma, Items);
292 -- Ada 2005 (AI-397): Reserved words NOT and OVERRIDING
293 -- may begin an entry declaration.
295 elsif Token = Tok_Entry
296 or else Token = Tok_Not
297 or else Token = Tok_Overriding
299 Append (P_Entry_Declaration, Items);
301 elsif Token = Tok_For then
302 -- Representation clause in task declaration. The only rep
303 -- clause which is legal in a protected is an address clause,
304 -- so that is what we try to scan out.
306 Item_Node := P_Representation_Clause;
308 if Nkind (Item_Node) = N_At_Clause then
309 Append (Item_Node, Items);
311 elsif Nkind (Item_Node) = N_Attribute_Definition_Clause
312 and then Chars (Item_Node) = Name_Address
314 Append (Item_Node, Items);
318 ("the only representation clause " &
319 "allowed here is an address clause!", Decl_Sloc);
322 elsif Token = Tok_Identifier
323 or else Token in Token_Class_Declk
325 Error_Msg_SC ("illegal declaration in task definition");
326 Resync_Past_Semicolon;
340 -- Parsed by P_Task (9.1)
342 ----------------------------------
343 -- 9.4 Protected (also 10.1.3) --
344 ----------------------------------
346 -- PROTECTED_TYPE_DECLARATION ::=
347 -- protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
348 -- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
350 -- SINGLE_PROTECTED_DECLARATION ::=
351 -- protected DEFINING_IDENTIFIER
352 -- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
354 -- PROTECTED_BODY ::=
355 -- protected body DEFINING_IDENTIFIER is
356 -- {PROTECTED_OPERATION_ITEM}
357 -- end [protected_IDENTIFIER];
359 -- PROTECTED_BODY_STUB ::=
360 -- protected body DEFINING_IDENTIFIER is separate;
362 -- This routine scans out a protected declaration, protected body
363 -- or a protected stub.
365 -- The caller has checked that the initial token is PROTECTED and
366 -- scanned past it, so Token is set to the following token.
368 -- Error recovery: cannot raise Error_Resync
370 function P_Protected return Node_Id is
372 Protected_Node : Node_Id;
373 Protected_Sloc : Source_Ptr;
374 Scan_State : Saved_Scan_State;
378 Scope.Table (Scope.Last).Etyp := E_Name;
379 Scope.Table (Scope.Last).Ecol := Start_Column;
380 Scope.Table (Scope.Last).Lreq := False;
381 Protected_Sloc := Prev_Token_Ptr;
383 if Token = Tok_Body then
385 Name_Node := P_Defining_Identifier (C_Is);
386 Scope.Table (Scope.Last).Labl := Name_Node;
388 if Token = Tok_Left_Paren then
389 Error_Msg_SC ("discriminant part not allowed in protected body");
390 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
397 if Token = Tok_Separate then
398 Scan; -- past SEPARATE
399 Protected_Node := New_Node (N_Protected_Body_Stub, Protected_Sloc);
400 Set_Defining_Identifier (Protected_Node, Name_Node);
402 Pop_Scope_Stack; -- remove unused entry
407 Protected_Node := New_Node (N_Protected_Body, Protected_Sloc);
408 Set_Defining_Identifier (Protected_Node, Name_Node);
409 Set_Declarations (Protected_Node, P_Protected_Operation_Items);
410 End_Statements (Protected_Node);
413 return Protected_Node;
415 -- Otherwise we must have a protected declaration
418 if Token = Tok_Type then
421 New_Node (N_Protected_Type_Declaration, Protected_Sloc);
422 Name_Node := P_Defining_Identifier (C_Is);
423 Set_Defining_Identifier (Protected_Node, Name_Node);
424 Scope.Table (Scope.Last).Labl := Name_Node;
425 Set_Discriminant_Specifications
426 (Protected_Node, P_Known_Discriminant_Part_Opt);
430 New_Node (N_Single_Protected_Declaration, Protected_Sloc);
431 Name_Node := P_Defining_Identifier (C_Is);
432 Set_Defining_Identifier (Protected_Node, Name_Node);
434 if Token = Tok_Left_Paren then
436 ("discriminant part not allowed for single protected");
437 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
440 Scope.Table (Scope.Last).Labl := Name_Node;
443 -- Check for semicolon not followed by IS, this is something like
449 -- protected type r IS END;
451 if Token = Tok_Semicolon then
452 Save_Scan_State (Scan_State); -- at semicolon
453 Scan; -- past semicolon
455 if Token /= Tok_Is then
456 Restore_Scan_State (Scan_State);
457 Error_Msg_SC ("missing IS");
458 Set_Protected_Definition (Protected_Node,
459 Make_Protected_Definition (Token_Ptr,
460 Visible_Declarations => Empty_List,
461 End_Label => Empty));
463 SIS_Entry_Active := False;
464 End_Statements (Protected_Definition (Protected_Node));
465 Scan; -- past semicolon
466 return Protected_Node;
469 Error_Msg_SP ("|extra ""("" ignored");
476 if Token = Tok_New then
479 if Ada_Version < Ada_05 then
480 Error_Msg_SP ("protected interface is an Ada 2005 extension");
481 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
484 Set_Interface_List (Protected_Node, New_List);
487 Append (P_Qualified_Simple_Name,
488 Interface_List (Protected_Node));
490 exit when Token /= Tok_And;
494 if Token /= Tok_With then
495 Error_Msg_SC ("WITH expected");
501 Set_Protected_Definition (Protected_Node, P_Protected_Definition);
502 return Protected_Node;
506 -------------------------------------
507 -- 9.4 Protected Type Declaration --
508 -------------------------------------
510 -- Parsed by P_Protected (9.4)
512 ---------------------------------------
513 -- 9.4 Single Protected Declaration --
514 ---------------------------------------
516 -- Parsed by P_Protected (9.4)
518 -------------------------------
519 -- 9.4 Protected Definition --
520 -------------------------------
522 -- PROTECTED_DEFINITION ::=
523 -- {PROTECTED_OPERATION_DECLARATION}
525 -- {PROTECTED_ELEMENT_DECLARATION}]
526 -- end [protected_IDENTIFIER]
528 -- PROTECTED_ELEMENT_DECLARATION ::=
529 -- PROTECTED_OPERATION_DECLARATION
530 -- | COMPONENT_DECLARATION
532 -- The caller has already established the scope stack entry
534 -- Error recovery: cannot raise Error_Resync
536 function P_Protected_Definition return Node_Id is
541 Def_Node := New_Node (N_Protected_Definition, Token_Ptr);
543 -- Get rid of active SIS entry from outer scope. This means we will
544 -- miss some nested cases, but it doesn't seem worth the effort. See
545 -- discussion in Par for further details
547 SIS_Entry_Active := False;
549 -- Loop to scan visible declarations (protected operation declarations)
551 Set_Visible_Declarations (Def_Node, New_List);
554 Item_Node := P_Protected_Operation_Declaration_Opt;
555 exit when No (Item_Node);
556 Append (Item_Node, Visible_Declarations (Def_Node));
559 -- Deal with PRIVATE part (including graceful handling of multiple
562 Private_Loop : while Token = Tok_Private loop
563 if No (Private_Declarations (Def_Node)) then
564 Set_Private_Declarations (Def_Node, New_List);
566 Error_Msg_SC ("duplicate private part");
569 Scan; -- past PRIVATE
571 Declaration_Loop : loop
572 if Token = Tok_Identifier then
573 P_Component_Items (Private_Declarations (Def_Node));
575 Item_Node := P_Protected_Operation_Declaration_Opt;
576 exit Declaration_Loop when No (Item_Node);
577 Append (Item_Node, Private_Declarations (Def_Node));
579 end loop Declaration_Loop;
580 end loop Private_Loop;
582 End_Statements (Def_Node);
584 end P_Protected_Definition;
586 ------------------------------------------
587 -- 9.4 Protected Operation Declaration --
588 ------------------------------------------
590 -- PROTECTED_OPERATION_DECLARATION ::=
591 -- SUBPROGRAM_DECLARATION
592 -- | ENTRY_DECLARATION
593 -- | REPRESENTATION_CLAUSE
595 -- Error recovery: cannot raise Error_Resync
597 -- Note: a pragma can also be returned in this position
599 -- We are not currently permitting representation clauses to appear as
600 -- protected operation declarations, do we have to rethink this???
602 function P_Protected_Operation_Declaration_Opt return Node_Id is
606 function P_Entry_Or_Subprogram_With_Indicator return Node_Id;
607 -- Ada 2005 (AI-397): Parse an entry or a subprogram with an overriding
608 -- indicator. The caller has checked that the initial token is NOT or
611 ------------------------------------------
612 -- P_Entry_Or_Subprogram_With_Indicator --
613 ------------------------------------------
615 function P_Entry_Or_Subprogram_With_Indicator return Node_Id is
616 Decl : Node_Id := Error;
617 Is_Overriding : Boolean := False;
618 Not_Overriding : Boolean := False;
621 if Token = Tok_Not then
624 if Token = Tok_Overriding then
625 Scan; -- past OVERRIDING
626 Not_Overriding := True;
628 Error_Msg_SC ("OVERRIDING expected!");
632 Scan; -- past OVERRIDING
633 Is_Overriding := True;
636 if (Is_Overriding or else Not_Overriding) then
637 if Ada_Version < Ada_05 then
638 Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
639 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
641 elsif Token = Tok_Entry then
642 Decl := P_Entry_Declaration;
644 Set_Must_Override (Decl, Is_Overriding);
645 Set_Must_Not_Override (Decl, Not_Overriding);
647 elsif Token = Tok_Function or else Token = Tok_Procedure then
648 Decl := P_Subprogram (Pf_Decl);
650 Set_Must_Override (Specification (Decl), Is_Overriding);
651 Set_Must_Not_Override (Specification (Decl), Not_Overriding);
654 Error_Msg_SC ("ENTRY, FUNCTION or PROCEDURE expected!");
659 end P_Entry_Or_Subprogram_With_Indicator;
661 -- Start of processing for P_Protected_Operation_Declaration_Opt
664 -- This loop runs more than once only when a junk declaration
668 if Token = Tok_Pragma then
671 elsif Token = Tok_Not or else Token = Tok_Overriding then
672 return P_Entry_Or_Subprogram_With_Indicator;
674 elsif Token = Tok_Entry then
675 return P_Entry_Declaration;
677 elsif Token = Tok_Function or else Token = Tok_Procedure then
678 return P_Subprogram (Pf_Decl);
680 elsif Token = Tok_Identifier then
683 Skip_Declaration (L);
685 if Nkind (First (L)) = N_Object_Declaration then
687 ("component must be declared in private part of " &
688 "protected type", P);
691 ("illegal declaration in protected definition", P);
694 elsif Token in Token_Class_Declk then
695 Error_Msg_SC ("illegal declaration in protected definition");
696 Resync_Past_Semicolon;
698 -- Return now to avoid cascaded messages if next declaration
699 -- is a valid component declaration.
703 elsif Token = Tok_For then
705 ("representation clause not allowed in protected definition");
706 Resync_Past_Semicolon;
712 end P_Protected_Operation_Declaration_Opt;
714 -----------------------------------
715 -- 9.4 Protected Operation Item --
716 -----------------------------------
718 -- PROTECTED_OPERATION_ITEM ::=
719 -- SUBPROGRAM_DECLARATION
722 -- | REPRESENTATION_CLAUSE
724 -- This procedure parses and returns a list of protected operation items
726 -- We are not currently permitting representation clauses to appear
727 -- as protected operation items, do we have to rethink this???
729 function P_Protected_Operation_Items return List_Id is
733 Item_List := New_List;
736 if Token = Tok_Entry or else Bad_Spelling_Of (Tok_Entry) then
737 Append (P_Entry_Body, Item_List);
739 elsif Token = Tok_Function or else Bad_Spelling_Of (Tok_Function)
741 Token = Tok_Procedure or else Bad_Spelling_Of (Tok_Procedure)
743 Append (P_Subprogram (Pf_Decl_Pbod), Item_List);
745 elsif Token = Tok_Pragma or else Bad_Spelling_Of (Tok_Pragma) then
746 P_Pragmas_Opt (Item_List);
748 elsif Token = Tok_Private or else Bad_Spelling_Of (Tok_Private) then
749 Error_Msg_SC ("PRIVATE not allowed in protected body");
750 Scan; -- past PRIVATE
752 elsif Token = Tok_Identifier then
754 ("all components must be declared in spec!");
755 Resync_Past_Semicolon;
757 elsif Token in Token_Class_Declk then
758 Error_Msg_SC ("this declaration not allowed in protected body");
759 Resync_Past_Semicolon;
767 end P_Protected_Operation_Items;
769 ------------------------------
770 -- 9.5.2 Entry Declaration --
771 ------------------------------
773 -- ENTRY_DECLARATION ::=
774 -- [OVERRIDING_INDICATOR]
775 -- entry DEFINING_IDENTIFIER [(DISCRETE_SUBTYPE_DEFINITION)]
776 -- PARAMETER_PROFILE;
778 -- The caller has checked that the initial token is ENTRY, NOT or
781 -- Error recovery: cannot raise Error_Resync
783 function P_Entry_Declaration return Node_Id is
785 Scan_State : Saved_Scan_State;
787 -- Flags for optional overriding indication. Two flags are needed,
788 -- to distinguish positive and negative overriding indicators from
789 -- the absence of any indicator.
791 Is_Overriding : Boolean := False;
792 Not_Overriding : Boolean := False;
795 -- Ada 2005 (AI-397): Scan leading overriding indicator
797 if Token = Tok_Not then
800 if Token = Tok_Overriding then
801 Scan; -- part OVERRIDING
802 Not_Overriding := True;
804 Error_Msg_SC ("OVERRIDING expected!");
807 elsif Token = Tok_Overriding then
808 Scan; -- part OVERRIDING
809 Is_Overriding := True;
812 if (Is_Overriding or else Not_Overriding) then
813 if Ada_Version < Ada_05 then
814 Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
815 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
817 elsif Token /= Tok_Entry then
818 Error_Msg_SC ("ENTRY expected!");
822 Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
825 Set_Defining_Identifier
826 (Decl_Node, P_Defining_Identifier (C_Left_Paren_Semicolon));
828 -- If left paren, could be (Discrete_Subtype_Definition) or Formal_Part
830 if Token = Tok_Left_Paren then
833 -- If identifier after left paren, could still be either
835 if Token = Tok_Identifier then
836 Save_Scan_State (Scan_State); -- at Id
839 -- If comma or colon after Id, must be Formal_Part
841 if Token = Tok_Comma or else Token = Tok_Colon then
842 Restore_Scan_State (Scan_State); -- to Id
843 Set_Parameter_Specifications (Decl_Node, P_Formal_Part);
845 -- Else if Id without comma or colon, must be discrete subtype
849 Restore_Scan_State (Scan_State); -- to Id
850 Set_Discrete_Subtype_Definition
851 (Decl_Node, P_Discrete_Subtype_Definition);
853 Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
856 -- If no Id, must be discrete subtype definition
859 Set_Discrete_Subtype_Definition
860 (Decl_Node, P_Discrete_Subtype_Definition);
862 Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
866 if Is_Overriding then
867 Set_Must_Override (Decl_Node);
868 elsif Not_Overriding then
869 Set_Must_Not_Override (Decl_Node);
872 -- Error recovery check for illegal return
874 if Token = Tok_Return then
875 Error_Msg_SC ("entry cannot have return value!");
877 Discard_Junk_Node (P_Subtype_Indication);
880 -- Error recovery check for improper use of entry barrier in spec
882 if Token = Tok_When then
883 Error_Msg_SC ("barrier not allowed here (belongs in body)");
885 Discard_Junk_Node (P_Expression_No_Right_Paren);
893 Resync_Past_Semicolon;
895 end P_Entry_Declaration;
897 -----------------------------
898 -- 9.5.2 Accept Statement --
899 -----------------------------
901 -- ACCEPT_STATEMENT ::=
902 -- accept entry_DIRECT_NAME
903 -- [(ENTRY_INDEX)] PARAMETER_PROFILE [do
904 -- HANDLED_SEQUENCE_OF_STATEMENTS
905 -- end [entry_IDENTIFIER]];
907 -- The caller has checked that the initial token is ACCEPT
909 -- Error recovery: cannot raise Error_Resync. If an error occurs, the
910 -- scan is resynchronized past the next semicolon and control returns.
912 function P_Accept_Statement return Node_Id is
913 Scan_State : Saved_Scan_State;
914 Accept_Node : Node_Id;
919 Scope.Table (Scope.Last).Sloc := Token_Ptr;
920 Scope.Table (Scope.Last).Ecol := Start_Column;
922 Accept_Node := New_Node (N_Accept_Statement, Token_Ptr);
924 Scope.Table (Scope.Last).Labl := Token_Node;
926 Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
928 -- Left paren could be (Entry_Index) or Formal_Part, determine which
930 if Token = Tok_Left_Paren then
931 Save_Scan_State (Scan_State); -- at left paren
932 Scan; -- past left paren
934 -- If first token after left paren not identifier, then Entry_Index
936 if Token /= Tok_Identifier then
937 Set_Entry_Index (Accept_Node, P_Expression);
939 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
941 -- First token after left paren is identifier, could be either case
943 else -- Token = Tok_Identifier
944 Scan; -- past identifier
946 -- If identifier followed by comma or colon, must be Formal_Part
948 if Token = Tok_Comma or else Token = Tok_Colon then
949 Restore_Scan_State (Scan_State); -- to left paren
950 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
952 -- If identifier not followed by comma/colon, must be entry index
955 Restore_Scan_State (Scan_State); -- to left paren
956 Scan; -- past left paren (again!)
957 Set_Entry_Index (Accept_Node, P_Expression);
959 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
964 -- Scan out DO if present
966 if Token = Tok_Do then
967 Scope.Table (Scope.Last).Etyp := E_Name;
968 Scope.Table (Scope.Last).Lreq := False;
970 Hand_Seq := P_Handled_Sequence_Of_Statements;
971 Set_Handled_Statement_Sequence (Accept_Node, Hand_Seq);
972 End_Statements (Handled_Statement_Sequence (Accept_Node));
974 -- Exception handlers not allowed in Ada 95 node
976 if Present (Exception_Handlers (Hand_Seq)) then
977 if Ada_Version = Ada_83 then
979 ("(Ada 83) exception handlers in accept not allowed",
980 First_Non_Pragma (Exception_Handlers (Hand_Seq)));
985 Pop_Scope_Stack; -- discard unused entry
991 -- If error, resynchronize past semicolon
995 Resync_Past_Semicolon;
996 Pop_Scope_Stack; -- discard unused entry
999 end P_Accept_Statement;
1001 ------------------------
1002 -- 9.5.2 Entry Index --
1003 ------------------------
1005 -- Parsed by P_Expression (4.4)
1007 -----------------------
1008 -- 9.5.2 Entry Body --
1009 -----------------------
1012 -- entry DEFINING_IDENTIFIER ENTRY_BODY_FORMAL_PART ENTRY_BARRIER is
1015 -- HANDLED_SEQUENCE_OF_STATEMENTS
1016 -- end [entry_IDENTIFIER];
1018 -- The caller has checked that the initial token is ENTRY
1020 -- Error_Recovery: cannot raise Error_Resync
1022 function P_Entry_Body return Node_Id is
1023 Entry_Node : Node_Id;
1024 Formal_Part_Node : Node_Id;
1025 Name_Node : Node_Id;
1029 Entry_Node := New_Node (N_Entry_Body, Token_Ptr);
1032 Scope.Table (Scope.Last).Ecol := Start_Column;
1033 Scope.Table (Scope.Last).Lreq := False;
1034 Scope.Table (Scope.Last).Etyp := E_Name;
1036 Name_Node := P_Defining_Identifier;
1037 Set_Defining_Identifier (Entry_Node, Name_Node);
1038 Scope.Table (Scope.Last).Labl := Name_Node;
1040 Formal_Part_Node := P_Entry_Body_Formal_Part;
1041 Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node);
1043 Set_Condition (Formal_Part_Node, P_Entry_Barrier);
1044 Parse_Decls_Begin_End (Entry_Node);
1048 -----------------------------------
1049 -- 9.5.2 Entry Body Formal Part --
1050 -----------------------------------
1052 -- ENTRY_BODY_FORMAL_PART ::=
1053 -- [(ENTRY_INDEX_SPECIFICATION)] [PARAMETER_PART]
1055 -- Error_Recovery: cannot raise Error_Resync
1057 function P_Entry_Body_Formal_Part return Node_Id is
1058 Fpart_Node : Node_Id;
1059 Scan_State : Saved_Scan_State;
1062 Fpart_Node := New_Node (N_Entry_Body_Formal_Part, Token_Ptr);
1064 -- See if entry index specification present, and if so parse it
1066 if Token = Tok_Left_Paren then
1067 Save_Scan_State (Scan_State); -- at left paren
1068 Scan; -- past left paren
1070 if Token = Tok_For then
1071 Set_Entry_Index_Specification
1072 (Fpart_Node, P_Entry_Index_Specification);
1075 Restore_Scan_State (Scan_State); -- to left paren
1078 -- Check for (common?) case of left paren omitted before FOR. This
1079 -- is a tricky case, because the corresponding missing left paren
1080 -- can cause real havoc if a formal part is present which gets
1081 -- treated as part of the discrete subtype definition of the
1082 -- entry index specification, so just give error and resynchronize
1084 elsif Token = Tok_For then
1085 T_Left_Paren; -- to give error message
1089 Set_Parameter_Specifications (Fpart_Node, P_Parameter_Profile);
1091 end P_Entry_Body_Formal_Part;
1093 --------------------------
1094 -- 9.5.2 Entry Barrier --
1095 --------------------------
1097 -- ENTRY_BARRIER ::= when CONDITION
1099 -- Error_Recovery: cannot raise Error_Resync
1101 function P_Entry_Barrier return Node_Id is
1105 if Token = Tok_When then
1107 Bnode := P_Expression_No_Right_Paren;
1109 if Token = Tok_Colon_Equal then
1110 Error_Msg_SC ("|"":="" should be ""=""");
1112 Bnode := P_Expression_No_Right_Paren;
1116 T_When; -- to give error message
1122 end P_Entry_Barrier;
1124 --------------------------------------
1125 -- 9.5.2 Entry Index Specification --
1126 --------------------------------------
1128 -- ENTRY_INDEX_SPECIFICATION ::=
1129 -- for DEFINING_IDENTIFIER in DISCRETE_SUBTYPE_DEFINITION
1131 -- Error recovery: can raise Error_Resync
1133 function P_Entry_Index_Specification return Node_Id is
1134 Iterator_Node : Node_Id;
1137 Iterator_Node := New_Node (N_Entry_Index_Specification, Token_Ptr);
1139 Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier (C_In));
1141 Set_Discrete_Subtype_Definition
1142 (Iterator_Node, P_Discrete_Subtype_Definition);
1143 return Iterator_Node;
1144 end P_Entry_Index_Specification;
1146 ---------------------------------
1147 -- 9.5.3 Entry Call Statement --
1148 ---------------------------------
1150 -- Parsed by P_Name (4.1). Within a select, an entry call is parsed
1151 -- by P_Select_Statement (9.7)
1153 ------------------------------
1154 -- 9.5.4 Requeue Statement --
1155 ------------------------------
1157 -- REQUEUE_STATEMENT ::= requeue entry_NAME [with abort];
1159 -- The caller has checked that the initial token is requeue
1161 -- Error recovery: can raise Error_Resync
1163 function P_Requeue_Statement return Node_Id is
1164 Requeue_Node : Node_Id;
1167 Requeue_Node := New_Node (N_Requeue_Statement, Token_Ptr);
1168 Scan; -- past REQUEUE
1169 Set_Name (Requeue_Node, P_Name);
1171 if Token = Tok_With then
1174 Set_Abort_Present (Requeue_Node, True);
1178 return Requeue_Node;
1179 end P_Requeue_Statement;
1181 --------------------------
1182 -- 9.6 Delay Statement --
1183 --------------------------
1185 -- DELAY_STATEMENT ::=
1186 -- DELAY_UNTIL_STATEMENT
1187 -- | DELAY_RELATIVE_STATEMENT
1189 -- The caller has checked that the initial token is DELAY
1191 -- Error recovery: cannot raise Error_Resync
1193 function P_Delay_Statement return Node_Id is
1197 -- The following check for delay until misused in Ada 83 doesn't catch
1198 -- all cases, but it's good enough to catch most of them!
1200 if Token_Name = Name_Until then
1201 Check_95_Keyword (Tok_Until, Tok_Left_Paren);
1202 Check_95_Keyword (Tok_Until, Tok_Identifier);
1205 if Token = Tok_Until then
1206 return P_Delay_Until_Statement;
1208 return P_Delay_Relative_Statement;
1210 end P_Delay_Statement;
1212 --------------------------------
1213 -- 9.6 Delay Until Statement --
1214 --------------------------------
1216 -- DELAY_UNTIL_STATEMENT ::= delay until delay_EXPRESSION;
1218 -- The caller has checked that the initial token is DELAY, scanned it
1219 -- out and checked that the current token is UNTIL
1221 -- Error recovery: cannot raise Error_Resync
1223 function P_Delay_Until_Statement return Node_Id is
1224 Delay_Node : Node_Id;
1227 Delay_Node := New_Node (N_Delay_Until_Statement, Prev_Token_Ptr);
1229 Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
1232 end P_Delay_Until_Statement;
1234 -----------------------------------
1235 -- 9.6 Delay Relative Statement --
1236 -----------------------------------
1238 -- DELAY_RELATIVE_STATEMENT ::= delay delay_EXPRESSION;
1240 -- The caller has checked that the initial token is DELAY, scanned it
1241 -- out and determined that the current token is not UNTIL
1243 -- Error recovery: cannot raise Error_Resync
1245 function P_Delay_Relative_Statement return Node_Id is
1246 Delay_Node : Node_Id;
1249 Delay_Node := New_Node (N_Delay_Relative_Statement, Prev_Token_Ptr);
1250 Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
1251 Check_Simple_Expression_In_Ada_83 (Expression (Delay_Node));
1254 end P_Delay_Relative_Statement;
1256 ---------------------------
1257 -- 9.7 Select Statement --
1258 ---------------------------
1260 -- SELECT_STATEMENT ::=
1262 -- | TIMED_ENTRY_CALL
1263 -- | CONDITIONAL_ENTRY_CALL
1264 -- | ASYNCHRONOUS_SELECT
1266 -- SELECTIVE_ACCEPT ::=
1269 -- SELECT_ALTERNATIVE
1272 -- SELECT_ALTERNATIVE
1274 -- SEQUENCE_OF_STATEMENTS]
1277 -- GUARD ::= when CONDITION =>
1279 -- Note: the guard preceding a select alternative is included as part
1280 -- of the node generated for a selective accept alternative.
1282 -- SELECT_ALTERNATIVE ::=
1283 -- ACCEPT_ALTERNATIVE
1284 -- | DELAY_ALTERNATIVE
1285 -- | TERMINATE_ALTERNATIVE
1287 -- TIMED_ENTRY_CALL ::=
1289 -- ENTRY_CALL_ALTERNATIVE
1291 -- DELAY_ALTERNATIVE
1294 -- CONDITIONAL_ENTRY_CALL ::=
1296 -- ENTRY_CALL_ALTERNATIVE
1298 -- SEQUENCE_OF_STATEMENTS
1301 -- ENTRY_CALL_ALTERNATIVE ::=
1302 -- ENTRY_CALL_STATEMENT [SEQUENCE_OF_STATEMENTS]
1304 -- ASYNCHRONOUS_SELECT ::=
1306 -- TRIGGERING_ALTERNATIVE
1311 -- TRIGGERING_ALTERNATIVE ::=
1312 -- TRIGGERING_STATEMENT [SEQUENCE_OF_STATEMENTS]
1314 -- TRIGGERING_STATEMENT ::= ENTRY_CALL_STATEMENT | DELAY_STATEMENT
1316 -- The caller has checked that the initial token is SELECT
1318 -- Error recovery: can raise Error_Resync
1320 function P_Select_Statement return Node_Id is
1321 Select_Node : Node_Id;
1322 Select_Sloc : Source_Ptr;
1323 Stmnt_Sloc : Source_Ptr;
1324 Ecall_Node : Node_Id;
1325 Alternative : Node_Id;
1326 Select_Pragmas : List_Id;
1327 Alt_Pragmas : List_Id;
1328 Statement_List : List_Id;
1330 Cond_Expr : Node_Id;
1331 Delay_Stmnt : Node_Id;
1335 Scope.Table (Scope.Last).Etyp := E_Select;
1336 Scope.Table (Scope.Last).Ecol := Start_Column;
1337 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1338 Scope.Table (Scope.Last).Labl := Error;
1340 Select_Sloc := Token_Ptr;
1341 Scan; -- past SELECT
1342 Stmnt_Sloc := Token_Ptr;
1343 Select_Pragmas := P_Pragmas_Opt;
1345 -- If first token after select is designator, then we have an entry
1346 -- call, which must be the start of a conditional entry call, timed
1347 -- entry call or asynchronous select
1349 if Token in Token_Class_Desig then
1351 -- Scan entry call statement
1354 Ecall_Node := P_Name;
1356 -- ?? The following two clauses exactly parallel code in ch5
1357 -- and should be combined sometime
1359 if Nkind (Ecall_Node) = N_Indexed_Component then
1361 Prefix_Node : constant Node_Id := Prefix (Ecall_Node);
1362 Exprs_Node : constant List_Id := Expressions (Ecall_Node);
1365 Change_Node (Ecall_Node, N_Procedure_Call_Statement);
1366 Set_Name (Ecall_Node, Prefix_Node);
1367 Set_Parameter_Associations (Ecall_Node, Exprs_Node);
1370 elsif Nkind (Ecall_Node) = N_Function_Call then
1372 Fname_Node : constant Node_Id := Name (Ecall_Node);
1373 Params_List : constant List_Id :=
1374 Parameter_Associations (Ecall_Node);
1377 Change_Node (Ecall_Node, N_Procedure_Call_Statement);
1378 Set_Name (Ecall_Node, Fname_Node);
1379 Set_Parameter_Associations (Ecall_Node, Params_List);
1382 elsif Nkind (Ecall_Node) = N_Identifier
1383 or else Nkind (Ecall_Node) = N_Selected_Component
1385 -- Case of a call to a parameterless entry
1388 C_Node : constant Node_Id :=
1389 New_Node (N_Procedure_Call_Statement, Stmnt_Sloc);
1391 Set_Name (C_Node, Ecall_Node);
1392 Set_Parameter_Associations (C_Node, No_List);
1393 Ecall_Node := C_Node;
1400 when Error_Resync =>
1401 Resync_Past_Semicolon;
1405 Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
1407 -- OR follows, we have a timed entry call
1409 if Token = Tok_Or then
1411 Alt_Pragmas := P_Pragmas_Opt;
1413 Select_Node := New_Node (N_Timed_Entry_Call, Select_Sloc);
1414 Set_Entry_Call_Alternative (Select_Node,
1415 Make_Entry_Call_Alternative (Stmnt_Sloc,
1416 Entry_Call_Statement => Ecall_Node,
1417 Pragmas_Before => Select_Pragmas,
1418 Statements => Statement_List));
1420 -- Only possibility is delay alternative. If we have anything
1421 -- else, give message, and treat as conditional entry call.
1423 if Token /= Tok_Delay then
1425 ("only allowed alternative in timed entry call is delay!");
1426 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
1427 Set_Delay_Alternative (Select_Node, Error);
1430 Set_Delay_Alternative (Select_Node, P_Delay_Alternative);
1432 (Delay_Alternative (Select_Node), Alt_Pragmas);
1435 -- ELSE follows, we have a conditional entry call
1437 elsif Token = Tok_Else then
1439 Select_Node := New_Node (N_Conditional_Entry_Call, Select_Sloc);
1441 Set_Entry_Call_Alternative (Select_Node,
1442 Make_Entry_Call_Alternative (Stmnt_Sloc,
1443 Entry_Call_Statement => Ecall_Node,
1444 Pragmas_Before => Select_Pragmas,
1445 Statements => Statement_List));
1448 (Select_Node, P_Sequence_Of_Statements (SS_Sreq));
1450 -- Only remaining case is THEN ABORT (asynchronous select)
1452 elsif Token = Tok_Abort then
1454 Make_Asynchronous_Select (Select_Sloc,
1455 Triggering_Alternative =>
1456 Make_Triggering_Alternative (Stmnt_Sloc,
1457 Triggering_Statement => Ecall_Node,
1458 Pragmas_Before => Select_Pragmas,
1459 Statements => Statement_List),
1460 Abortable_Part => P_Abortable_Part);
1465 if Ada_Version = Ada_83 then
1466 Error_Msg_BC ("OR or ELSE expected");
1468 Error_Msg_BC ("OR or ELSE or THEN ABORT expected");
1471 Select_Node := Error;
1476 -- Here we have a selective accept or an asynchronous select (first
1477 -- token after SELECT is other than a designator token).
1480 -- If we have delay with no guard, could be asynchronous select
1482 if Token = Tok_Delay then
1483 Delay_Stmnt := P_Delay_Statement;
1484 Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
1486 -- Asynchronous select
1488 if Token = Tok_Abort then
1490 Make_Asynchronous_Select (Select_Sloc,
1491 Triggering_Alternative =>
1492 Make_Triggering_Alternative (Stmnt_Sloc,
1493 Triggering_Statement => Delay_Stmnt,
1494 Pragmas_Before => Select_Pragmas,
1495 Statements => Statement_List),
1496 Abortable_Part => P_Abortable_Part);
1501 -- Delay which was not an asynchronous select. Must be a selective
1502 -- accept, and since at least one accept statement is required,
1503 -- we must have at least one OR phrase present.
1506 Alt_List := New_List (
1507 Make_Delay_Alternative (Stmnt_Sloc,
1508 Delay_Statement => Delay_Stmnt,
1509 Pragmas_Before => Select_Pragmas,
1510 Statements => Statement_List));
1512 Alt_Pragmas := P_Pragmas_Opt;
1515 -- If not a delay statement, then must be another possibility for
1516 -- a selective accept alternative, or perhaps a guard is present
1519 Alt_List := New_List;
1520 Alt_Pragmas := Select_Pragmas;
1523 Select_Node := New_Node (N_Selective_Accept, Select_Sloc);
1524 Set_Select_Alternatives (Select_Node, Alt_List);
1526 -- Scan out selective accept alternatives. On entry to this loop,
1527 -- we are just past a SELECT or OR token, and any pragmas that
1528 -- immediately follow the SELECT or OR are in Alt_Pragmas.
1531 if Token = Tok_When then
1533 if Present (Alt_Pragmas) then
1534 Error_Msg_SC ("pragmas may not precede guard");
1538 Cond_Expr := P_Expression_No_Right_Paren;
1540 Alt_Pragmas := P_Pragmas_Opt;
1546 if Token = Tok_Accept then
1547 Alternative := P_Accept_Alternative;
1549 -- Check for junk attempt at asynchronous select using
1550 -- an Accept alternative as the triggering statement
1552 if Token = Tok_Abort
1553 and then Is_Empty_List (Alt_List)
1554 and then No (Cond_Expr)
1557 ("triggering statement must be entry call or delay",
1558 Sloc (Alternative));
1559 Scan; -- past junk ABORT
1560 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
1565 elsif Token = Tok_Delay then
1566 Alternative := P_Delay_Alternative;
1568 elsif Token = Tok_Terminate then
1569 Alternative := P_Terminate_Alternative;
1573 ("select alternative (ACCEPT, ABORT, DELAY) expected");
1574 Alternative := Error;
1576 if Token = Tok_Semicolon then
1577 Scan; -- past junk semicolon
1581 -- THEN ABORT at this stage is just junk
1583 if Token = Tok_Abort then
1584 Error_Msg_SP ("misplaced `THEN ABORT`");
1585 Scan; -- past junk ABORT
1586 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
1591 if Alternative /= Error then
1592 Set_Condition (Alternative, Cond_Expr);
1593 Set_Pragmas_Before (Alternative, Alt_Pragmas);
1594 Append (Alternative, Alt_List);
1597 exit when Token /= Tok_Or;
1601 Alt_Pragmas := P_Pragmas_Opt;
1604 if Token = Tok_Else then
1607 (Select_Node, P_Sequence_Of_Statements (SS_Ortm_Sreq));
1609 if Token = Tok_Or then
1610 Error_Msg_SC ("select alternative cannot follow else part!");
1618 end P_Select_Statement;
1620 -----------------------------
1621 -- 9.7.1 Selective Accept --
1622 -----------------------------
1624 -- Parsed by P_Select_Statement (9.7)
1630 -- Parsed by P_Select_Statement (9.7)
1632 -------------------------------
1633 -- 9.7.1 Select Alternative --
1634 -------------------------------
1636 -- SELECT_ALTERNATIVE ::=
1637 -- ACCEPT_ALTERNATIVE
1638 -- | DELAY_ALTERNATIVE
1639 -- | TERMINATE_ALTERNATIVE
1641 -- Note: the guard preceding a select alternative is included as part
1642 -- of the node generated for a selective accept alternative.
1644 -- Error recovery: cannot raise Error_Resync
1646 -------------------------------
1647 -- 9.7.1 Accept Alternative --
1648 -------------------------------
1650 -- ACCEPT_ALTERNATIVE ::=
1651 -- ACCEPT_STATEMENT [SEQUENCE_OF_STATEMENTS]
1653 -- Error_Recovery: Cannot raise Error_Resync
1655 -- Note: the caller is responsible for setting the Pragmas_Before
1656 -- field of the returned N_Terminate_Alternative node.
1658 function P_Accept_Alternative return Node_Id is
1659 Accept_Alt_Node : Node_Id;
1662 Accept_Alt_Node := New_Node (N_Accept_Alternative, Token_Ptr);
1663 Set_Accept_Statement (Accept_Alt_Node, P_Accept_Statement);
1665 -- Note: the reason that we accept THEN ABORT as a terminator for
1666 -- the sequence of statements is for error recovery which allows
1667 -- for misuse of an accept statement as a triggering statement.
1670 (Accept_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
1671 return Accept_Alt_Node;
1672 end P_Accept_Alternative;
1674 ------------------------------
1675 -- 9.7.1 Delay Alternative --
1676 ------------------------------
1678 -- DELAY_ALTERNATIVE ::=
1679 -- DELAY_STATEMENT [SEQUENCE_OF_STATEMENTS]
1681 -- Error_Recovery: Cannot raise Error_Resync
1683 -- Note: the caller is responsible for setting the Pragmas_Before
1684 -- field of the returned N_Terminate_Alternative node.
1686 function P_Delay_Alternative return Node_Id is
1687 Delay_Alt_Node : Node_Id;
1690 Delay_Alt_Node := New_Node (N_Delay_Alternative, Token_Ptr);
1691 Set_Delay_Statement (Delay_Alt_Node, P_Delay_Statement);
1693 -- Note: the reason that we accept THEN ABORT as a terminator for
1694 -- the sequence of statements is for error recovery which allows
1695 -- for misuse of an accept statement as a triggering statement.
1698 (Delay_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
1699 return Delay_Alt_Node;
1700 end P_Delay_Alternative;
1702 ----------------------------------
1703 -- 9.7.1 Terminate Alternative --
1704 ----------------------------------
1706 -- TERMINATE_ALTERNATIVE ::= terminate;
1708 -- Error_Recovery: Cannot raise Error_Resync
1710 -- Note: the caller is responsible for setting the Pragmas_Before
1711 -- field of the returned N_Terminate_Alternative node.
1713 function P_Terminate_Alternative return Node_Id is
1714 Terminate_Alt_Node : Node_Id;
1717 Terminate_Alt_Node := New_Node (N_Terminate_Alternative, Token_Ptr);
1718 Scan; -- past TERMINATE
1721 -- For all other select alternatives, the sequence of statements
1722 -- after the alternative statement will swallow up any pragmas
1723 -- coming in this position. But the terminate alternative has no
1724 -- sequence of statements, so the pragmas here must be treated
1727 Set_Pragmas_After (Terminate_Alt_Node, P_Pragmas_Opt);
1728 return Terminate_Alt_Node;
1729 end P_Terminate_Alternative;
1731 -----------------------------
1732 -- 9.7.2 Timed Entry Call --
1733 -----------------------------
1735 -- Parsed by P_Select_Statement (9.7)
1737 -----------------------------------
1738 -- 9.7.2 Entry Call Alternative --
1739 -----------------------------------
1741 -- Parsed by P_Select_Statement (9.7)
1743 -----------------------------------
1744 -- 9.7.3 Conditional Entry Call --
1745 -----------------------------------
1747 -- Parsed by P_Select_Statement (9.7)
1749 --------------------------------
1750 -- 9.7.4 Asynchronous Select --
1751 --------------------------------
1753 -- Parsed by P_Select_Statement (9.7)
1755 -----------------------------------
1756 -- 9.7.4 Triggering Alternative --
1757 -----------------------------------
1759 -- Parsed by P_Select_Statement (9.7)
1761 ---------------------------------
1762 -- 9.7.4 Triggering Statement --
1763 ---------------------------------
1765 -- Parsed by P_Select_Statement (9.7)
1767 ---------------------------
1768 -- 9.7.4 Abortable Part --
1769 ---------------------------
1771 -- ABORTABLE_PART ::= SEQUENCE_OF_STATEMENTS
1773 -- The caller has verified that THEN ABORT is present, and Token is
1774 -- pointing to the ABORT on entry (or if not, then we have an error)
1776 -- Error recovery: cannot raise Error_Resync
1778 function P_Abortable_Part return Node_Id is
1779 Abortable_Part_Node : Node_Id;
1782 Abortable_Part_Node := New_Node (N_Abortable_Part, Token_Ptr);
1783 T_Abort; -- scan past ABORT
1785 if Ada_Version = Ada_83 then
1786 Error_Msg_SP ("(Ada 83) asynchronous select not allowed!");
1789 Set_Statements (Abortable_Part_Node, P_Sequence_Of_Statements (SS_Sreq));
1790 return Abortable_Part_Node;
1791 end P_Abortable_Part;
1793 --------------------------
1794 -- 9.8 Abort Statement --
1795 --------------------------
1797 -- ABORT_STATEMENT ::= abort task_NAME {, task_NAME};
1799 -- The caller has checked that the initial token is ABORT
1801 -- Error recovery: cannot raise Error_Resync
1803 function P_Abort_Statement return Node_Id is
1804 Abort_Node : Node_Id;
1807 Abort_Node := New_Node (N_Abort_Statement, Token_Ptr);
1809 Set_Names (Abort_Node, New_List);
1812 Append (P_Name, Names (Abort_Node));
1813 exit when Token /= Tok_Comma;
1819 end P_Abort_Statement;