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 -- If the operation starts with procedure, function, or an overriding
740 -- indicator ("overriding" or "not overriding"), parse a subprogram.
742 elsif Token = Tok_Function or else Bad_Spelling_Of (Tok_Function)
744 Token = Tok_Procedure or else Bad_Spelling_Of (Tok_Procedure)
746 Token = Tok_Overriding or else Bad_Spelling_Of (Tok_Overriding)
748 Token = Tok_Not or else Bad_Spelling_Of (Tok_Not)
750 Append (P_Subprogram (Pf_Decl_Pbod), Item_List);
752 elsif Token = Tok_Pragma or else Bad_Spelling_Of (Tok_Pragma) then
753 P_Pragmas_Opt (Item_List);
755 elsif Token = Tok_Private or else Bad_Spelling_Of (Tok_Private) then
756 Error_Msg_SC ("PRIVATE not allowed in protected body");
757 Scan; -- past PRIVATE
759 elsif Token = Tok_Identifier then
761 ("all components must be declared in spec!");
762 Resync_Past_Semicolon;
764 elsif Token in Token_Class_Declk then
765 Error_Msg_SC ("this declaration not allowed in protected body");
766 Resync_Past_Semicolon;
774 end P_Protected_Operation_Items;
776 ------------------------------
777 -- 9.5.2 Entry Declaration --
778 ------------------------------
780 -- ENTRY_DECLARATION ::=
781 -- [OVERRIDING_INDICATOR]
782 -- entry DEFINING_IDENTIFIER [(DISCRETE_SUBTYPE_DEFINITION)]
783 -- PARAMETER_PROFILE;
785 -- The caller has checked that the initial token is ENTRY, NOT or
788 -- Error recovery: cannot raise Error_Resync
790 function P_Entry_Declaration return Node_Id is
792 Scan_State : Saved_Scan_State;
794 -- Flags for optional overriding indication. Two flags are needed,
795 -- to distinguish positive and negative overriding indicators from
796 -- the absence of any indicator.
798 Is_Overriding : Boolean := False;
799 Not_Overriding : Boolean := False;
802 -- Ada 2005 (AI-397): Scan leading overriding indicator
804 if Token = Tok_Not then
807 if Token = Tok_Overriding then
808 Scan; -- part OVERRIDING
809 Not_Overriding := True;
811 Error_Msg_SC ("OVERRIDING expected!");
814 elsif Token = Tok_Overriding then
815 Scan; -- part OVERRIDING
816 Is_Overriding := True;
819 if (Is_Overriding or else Not_Overriding) then
820 if Ada_Version < Ada_05 then
821 Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
822 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
824 elsif Token /= Tok_Entry then
825 Error_Msg_SC ("ENTRY expected!");
829 Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
832 Set_Defining_Identifier
833 (Decl_Node, P_Defining_Identifier (C_Left_Paren_Semicolon));
835 -- If left paren, could be (Discrete_Subtype_Definition) or Formal_Part
837 if Token = Tok_Left_Paren then
840 -- If identifier after left paren, could still be either
842 if Token = Tok_Identifier then
843 Save_Scan_State (Scan_State); -- at Id
846 -- If comma or colon after Id, must be Formal_Part
848 if Token = Tok_Comma or else Token = Tok_Colon then
849 Restore_Scan_State (Scan_State); -- to Id
850 Set_Parameter_Specifications (Decl_Node, P_Formal_Part);
852 -- Else if Id without comma or colon, must be discrete subtype
856 Restore_Scan_State (Scan_State); -- to Id
857 Set_Discrete_Subtype_Definition
858 (Decl_Node, P_Discrete_Subtype_Definition);
860 Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
863 -- If no Id, must be discrete subtype definition
866 Set_Discrete_Subtype_Definition
867 (Decl_Node, P_Discrete_Subtype_Definition);
869 Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
873 if Is_Overriding then
874 Set_Must_Override (Decl_Node);
875 elsif Not_Overriding then
876 Set_Must_Not_Override (Decl_Node);
879 -- Error recovery check for illegal return
881 if Token = Tok_Return then
882 Error_Msg_SC ("entry cannot have return value!");
884 Discard_Junk_Node (P_Subtype_Indication);
887 -- Error recovery check for improper use of entry barrier in spec
889 if Token = Tok_When then
890 Error_Msg_SC ("barrier not allowed here (belongs in body)");
892 Discard_Junk_Node (P_Expression_No_Right_Paren);
900 Resync_Past_Semicolon;
902 end P_Entry_Declaration;
904 -----------------------------
905 -- 9.5.2 Accept Statement --
906 -----------------------------
908 -- ACCEPT_STATEMENT ::=
909 -- accept entry_DIRECT_NAME
910 -- [(ENTRY_INDEX)] PARAMETER_PROFILE [do
911 -- HANDLED_SEQUENCE_OF_STATEMENTS
912 -- end [entry_IDENTIFIER]];
914 -- The caller has checked that the initial token is ACCEPT
916 -- Error recovery: cannot raise Error_Resync. If an error occurs, the
917 -- scan is resynchronized past the next semicolon and control returns.
919 function P_Accept_Statement return Node_Id is
920 Scan_State : Saved_Scan_State;
921 Accept_Node : Node_Id;
926 Scope.Table (Scope.Last).Sloc := Token_Ptr;
927 Scope.Table (Scope.Last).Ecol := Start_Column;
929 Accept_Node := New_Node (N_Accept_Statement, Token_Ptr);
931 Scope.Table (Scope.Last).Labl := Token_Node;
933 Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
935 -- Left paren could be (Entry_Index) or Formal_Part, determine which
937 if Token = Tok_Left_Paren then
938 Save_Scan_State (Scan_State); -- at left paren
939 Scan; -- past left paren
941 -- If first token after left paren not identifier, then Entry_Index
943 if Token /= Tok_Identifier then
944 Set_Entry_Index (Accept_Node, P_Expression);
946 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
948 -- First token after left paren is identifier, could be either case
950 else -- Token = Tok_Identifier
951 Scan; -- past identifier
953 -- If identifier followed by comma or colon, must be Formal_Part
955 if Token = Tok_Comma or else Token = Tok_Colon then
956 Restore_Scan_State (Scan_State); -- to left paren
957 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
959 -- If identifier not followed by comma/colon, must be entry index
962 Restore_Scan_State (Scan_State); -- to left paren
963 Scan; -- past left paren (again!)
964 Set_Entry_Index (Accept_Node, P_Expression);
966 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
971 -- Scan out DO if present
973 if Token = Tok_Do then
974 Scope.Table (Scope.Last).Etyp := E_Name;
975 Scope.Table (Scope.Last).Lreq := False;
977 Hand_Seq := P_Handled_Sequence_Of_Statements;
978 Set_Handled_Statement_Sequence (Accept_Node, Hand_Seq);
979 End_Statements (Handled_Statement_Sequence (Accept_Node));
981 -- Exception handlers not allowed in Ada 95 node
983 if Present (Exception_Handlers (Hand_Seq)) then
984 if Ada_Version = Ada_83 then
986 ("(Ada 83) exception handlers in accept not allowed",
987 First_Non_Pragma (Exception_Handlers (Hand_Seq)));
992 Pop_Scope_Stack; -- discard unused entry
998 -- If error, resynchronize past semicolon
1001 when Error_Resync =>
1002 Resync_Past_Semicolon;
1003 Pop_Scope_Stack; -- discard unused entry
1006 end P_Accept_Statement;
1008 ------------------------
1009 -- 9.5.2 Entry Index --
1010 ------------------------
1012 -- Parsed by P_Expression (4.4)
1014 -----------------------
1015 -- 9.5.2 Entry Body --
1016 -----------------------
1019 -- entry DEFINING_IDENTIFIER ENTRY_BODY_FORMAL_PART ENTRY_BARRIER is
1022 -- HANDLED_SEQUENCE_OF_STATEMENTS
1023 -- end [entry_IDENTIFIER];
1025 -- The caller has checked that the initial token is ENTRY
1027 -- Error_Recovery: cannot raise Error_Resync
1029 function P_Entry_Body return Node_Id is
1030 Entry_Node : Node_Id;
1031 Formal_Part_Node : Node_Id;
1032 Name_Node : Node_Id;
1036 Entry_Node := New_Node (N_Entry_Body, Token_Ptr);
1039 Scope.Table (Scope.Last).Ecol := Start_Column;
1040 Scope.Table (Scope.Last).Lreq := False;
1041 Scope.Table (Scope.Last).Etyp := E_Name;
1043 Name_Node := P_Defining_Identifier;
1044 Set_Defining_Identifier (Entry_Node, Name_Node);
1045 Scope.Table (Scope.Last).Labl := Name_Node;
1047 Formal_Part_Node := P_Entry_Body_Formal_Part;
1048 Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node);
1050 Set_Condition (Formal_Part_Node, P_Entry_Barrier);
1051 Parse_Decls_Begin_End (Entry_Node);
1055 -----------------------------------
1056 -- 9.5.2 Entry Body Formal Part --
1057 -----------------------------------
1059 -- ENTRY_BODY_FORMAL_PART ::=
1060 -- [(ENTRY_INDEX_SPECIFICATION)] [PARAMETER_PART]
1062 -- Error_Recovery: cannot raise Error_Resync
1064 function P_Entry_Body_Formal_Part return Node_Id is
1065 Fpart_Node : Node_Id;
1066 Scan_State : Saved_Scan_State;
1069 Fpart_Node := New_Node (N_Entry_Body_Formal_Part, Token_Ptr);
1071 -- See if entry index specification present, and if so parse it
1073 if Token = Tok_Left_Paren then
1074 Save_Scan_State (Scan_State); -- at left paren
1075 Scan; -- past left paren
1077 if Token = Tok_For then
1078 Set_Entry_Index_Specification
1079 (Fpart_Node, P_Entry_Index_Specification);
1082 Restore_Scan_State (Scan_State); -- to left paren
1085 -- Check for (common?) case of left paren omitted before FOR. This
1086 -- is a tricky case, because the corresponding missing left paren
1087 -- can cause real havoc if a formal part is present which gets
1088 -- treated as part of the discrete subtype definition of the
1089 -- entry index specification, so just give error and resynchronize
1091 elsif Token = Tok_For then
1092 T_Left_Paren; -- to give error message
1096 Set_Parameter_Specifications (Fpart_Node, P_Parameter_Profile);
1098 end P_Entry_Body_Formal_Part;
1100 --------------------------
1101 -- 9.5.2 Entry Barrier --
1102 --------------------------
1104 -- ENTRY_BARRIER ::= when CONDITION
1106 -- Error_Recovery: cannot raise Error_Resync
1108 function P_Entry_Barrier return Node_Id is
1112 if Token = Tok_When then
1114 Bnode := P_Expression_No_Right_Paren;
1116 if Token = Tok_Colon_Equal then
1117 Error_Msg_SC ("|"":="" should be ""=""");
1119 Bnode := P_Expression_No_Right_Paren;
1123 T_When; -- to give error message
1129 end P_Entry_Barrier;
1131 --------------------------------------
1132 -- 9.5.2 Entry Index Specification --
1133 --------------------------------------
1135 -- ENTRY_INDEX_SPECIFICATION ::=
1136 -- for DEFINING_IDENTIFIER in DISCRETE_SUBTYPE_DEFINITION
1138 -- Error recovery: can raise Error_Resync
1140 function P_Entry_Index_Specification return Node_Id is
1141 Iterator_Node : Node_Id;
1144 Iterator_Node := New_Node (N_Entry_Index_Specification, Token_Ptr);
1146 Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier (C_In));
1148 Set_Discrete_Subtype_Definition
1149 (Iterator_Node, P_Discrete_Subtype_Definition);
1150 return Iterator_Node;
1151 end P_Entry_Index_Specification;
1153 ---------------------------------
1154 -- 9.5.3 Entry Call Statement --
1155 ---------------------------------
1157 -- Parsed by P_Name (4.1). Within a select, an entry call is parsed
1158 -- by P_Select_Statement (9.7)
1160 ------------------------------
1161 -- 9.5.4 Requeue Statement --
1162 ------------------------------
1164 -- REQUEUE_STATEMENT ::= requeue entry_NAME [with abort];
1166 -- The caller has checked that the initial token is requeue
1168 -- Error recovery: can raise Error_Resync
1170 function P_Requeue_Statement return Node_Id is
1171 Requeue_Node : Node_Id;
1174 Requeue_Node := New_Node (N_Requeue_Statement, Token_Ptr);
1175 Scan; -- past REQUEUE
1176 Set_Name (Requeue_Node, P_Name);
1178 if Token = Tok_With then
1181 Set_Abort_Present (Requeue_Node, True);
1185 return Requeue_Node;
1186 end P_Requeue_Statement;
1188 --------------------------
1189 -- 9.6 Delay Statement --
1190 --------------------------
1192 -- DELAY_STATEMENT ::=
1193 -- DELAY_UNTIL_STATEMENT
1194 -- | DELAY_RELATIVE_STATEMENT
1196 -- The caller has checked that the initial token is DELAY
1198 -- Error recovery: cannot raise Error_Resync
1200 function P_Delay_Statement return Node_Id is
1204 -- The following check for delay until misused in Ada 83 doesn't catch
1205 -- all cases, but it's good enough to catch most of them!
1207 if Token_Name = Name_Until then
1208 Check_95_Keyword (Tok_Until, Tok_Left_Paren);
1209 Check_95_Keyword (Tok_Until, Tok_Identifier);
1212 if Token = Tok_Until then
1213 return P_Delay_Until_Statement;
1215 return P_Delay_Relative_Statement;
1217 end P_Delay_Statement;
1219 --------------------------------
1220 -- 9.6 Delay Until Statement --
1221 --------------------------------
1223 -- DELAY_UNTIL_STATEMENT ::= delay until delay_EXPRESSION;
1225 -- The caller has checked that the initial token is DELAY, scanned it
1226 -- out and checked that the current token is UNTIL
1228 -- Error recovery: cannot raise Error_Resync
1230 function P_Delay_Until_Statement return Node_Id is
1231 Delay_Node : Node_Id;
1234 Delay_Node := New_Node (N_Delay_Until_Statement, Prev_Token_Ptr);
1236 Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
1239 end P_Delay_Until_Statement;
1241 -----------------------------------
1242 -- 9.6 Delay Relative Statement --
1243 -----------------------------------
1245 -- DELAY_RELATIVE_STATEMENT ::= delay delay_EXPRESSION;
1247 -- The caller has checked that the initial token is DELAY, scanned it
1248 -- out and determined that the current token is not UNTIL
1250 -- Error recovery: cannot raise Error_Resync
1252 function P_Delay_Relative_Statement return Node_Id is
1253 Delay_Node : Node_Id;
1256 Delay_Node := New_Node (N_Delay_Relative_Statement, Prev_Token_Ptr);
1257 Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
1258 Check_Simple_Expression_In_Ada_83 (Expression (Delay_Node));
1261 end P_Delay_Relative_Statement;
1263 ---------------------------
1264 -- 9.7 Select Statement --
1265 ---------------------------
1267 -- SELECT_STATEMENT ::=
1269 -- | TIMED_ENTRY_CALL
1270 -- | CONDITIONAL_ENTRY_CALL
1271 -- | ASYNCHRONOUS_SELECT
1273 -- SELECTIVE_ACCEPT ::=
1276 -- SELECT_ALTERNATIVE
1279 -- SELECT_ALTERNATIVE
1281 -- SEQUENCE_OF_STATEMENTS]
1284 -- GUARD ::= when CONDITION =>
1286 -- Note: the guard preceding a select alternative is included as part
1287 -- of the node generated for a selective accept alternative.
1289 -- SELECT_ALTERNATIVE ::=
1290 -- ACCEPT_ALTERNATIVE
1291 -- | DELAY_ALTERNATIVE
1292 -- | TERMINATE_ALTERNATIVE
1294 -- TIMED_ENTRY_CALL ::=
1296 -- ENTRY_CALL_ALTERNATIVE
1298 -- DELAY_ALTERNATIVE
1301 -- CONDITIONAL_ENTRY_CALL ::=
1303 -- ENTRY_CALL_ALTERNATIVE
1305 -- SEQUENCE_OF_STATEMENTS
1308 -- ENTRY_CALL_ALTERNATIVE ::=
1309 -- ENTRY_CALL_STATEMENT [SEQUENCE_OF_STATEMENTS]
1311 -- ASYNCHRONOUS_SELECT ::=
1313 -- TRIGGERING_ALTERNATIVE
1318 -- TRIGGERING_ALTERNATIVE ::=
1319 -- TRIGGERING_STATEMENT [SEQUENCE_OF_STATEMENTS]
1321 -- TRIGGERING_STATEMENT ::= ENTRY_CALL_STATEMENT | DELAY_STATEMENT
1323 -- The caller has checked that the initial token is SELECT
1325 -- Error recovery: can raise Error_Resync
1327 function P_Select_Statement return Node_Id is
1328 Select_Node : Node_Id;
1329 Select_Sloc : Source_Ptr;
1330 Stmnt_Sloc : Source_Ptr;
1331 Ecall_Node : Node_Id;
1332 Alternative : Node_Id;
1333 Select_Pragmas : List_Id;
1334 Alt_Pragmas : List_Id;
1335 Statement_List : List_Id;
1337 Cond_Expr : Node_Id;
1338 Delay_Stmnt : Node_Id;
1342 Scope.Table (Scope.Last).Etyp := E_Select;
1343 Scope.Table (Scope.Last).Ecol := Start_Column;
1344 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1345 Scope.Table (Scope.Last).Labl := Error;
1347 Select_Sloc := Token_Ptr;
1348 Scan; -- past SELECT
1349 Stmnt_Sloc := Token_Ptr;
1350 Select_Pragmas := P_Pragmas_Opt;
1352 -- If first token after select is designator, then we have an entry
1353 -- call, which must be the start of a conditional entry call, timed
1354 -- entry call or asynchronous select
1356 if Token in Token_Class_Desig then
1358 -- Scan entry call statement
1361 Ecall_Node := P_Name;
1363 -- ?? The following two clauses exactly parallel code in ch5
1364 -- and should be combined sometime
1366 if Nkind (Ecall_Node) = N_Indexed_Component then
1368 Prefix_Node : constant Node_Id := Prefix (Ecall_Node);
1369 Exprs_Node : constant List_Id := Expressions (Ecall_Node);
1372 Change_Node (Ecall_Node, N_Procedure_Call_Statement);
1373 Set_Name (Ecall_Node, Prefix_Node);
1374 Set_Parameter_Associations (Ecall_Node, Exprs_Node);
1377 elsif Nkind (Ecall_Node) = N_Function_Call then
1379 Fname_Node : constant Node_Id := Name (Ecall_Node);
1380 Params_List : constant List_Id :=
1381 Parameter_Associations (Ecall_Node);
1384 Change_Node (Ecall_Node, N_Procedure_Call_Statement);
1385 Set_Name (Ecall_Node, Fname_Node);
1386 Set_Parameter_Associations (Ecall_Node, Params_List);
1389 elsif Nkind (Ecall_Node) = N_Identifier
1390 or else Nkind (Ecall_Node) = N_Selected_Component
1392 -- Case of a call to a parameterless entry
1395 C_Node : constant Node_Id :=
1396 New_Node (N_Procedure_Call_Statement, Stmnt_Sloc);
1398 Set_Name (C_Node, Ecall_Node);
1399 Set_Parameter_Associations (C_Node, No_List);
1400 Ecall_Node := C_Node;
1407 when Error_Resync =>
1408 Resync_Past_Semicolon;
1412 Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
1414 -- OR follows, we have a timed entry call
1416 if Token = Tok_Or then
1418 Alt_Pragmas := P_Pragmas_Opt;
1420 Select_Node := New_Node (N_Timed_Entry_Call, Select_Sloc);
1421 Set_Entry_Call_Alternative (Select_Node,
1422 Make_Entry_Call_Alternative (Stmnt_Sloc,
1423 Entry_Call_Statement => Ecall_Node,
1424 Pragmas_Before => Select_Pragmas,
1425 Statements => Statement_List));
1427 -- Only possibility is delay alternative. If we have anything
1428 -- else, give message, and treat as conditional entry call.
1430 if Token /= Tok_Delay then
1432 ("only allowed alternative in timed entry call is delay!");
1433 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
1434 Set_Delay_Alternative (Select_Node, Error);
1437 Set_Delay_Alternative (Select_Node, P_Delay_Alternative);
1439 (Delay_Alternative (Select_Node), Alt_Pragmas);
1442 -- ELSE follows, we have a conditional entry call
1444 elsif Token = Tok_Else then
1446 Select_Node := New_Node (N_Conditional_Entry_Call, Select_Sloc);
1448 Set_Entry_Call_Alternative (Select_Node,
1449 Make_Entry_Call_Alternative (Stmnt_Sloc,
1450 Entry_Call_Statement => Ecall_Node,
1451 Pragmas_Before => Select_Pragmas,
1452 Statements => Statement_List));
1455 (Select_Node, P_Sequence_Of_Statements (SS_Sreq));
1457 -- Only remaining case is THEN ABORT (asynchronous select)
1459 elsif Token = Tok_Abort then
1461 Make_Asynchronous_Select (Select_Sloc,
1462 Triggering_Alternative =>
1463 Make_Triggering_Alternative (Stmnt_Sloc,
1464 Triggering_Statement => Ecall_Node,
1465 Pragmas_Before => Select_Pragmas,
1466 Statements => Statement_List),
1467 Abortable_Part => P_Abortable_Part);
1472 if Ada_Version = Ada_83 then
1473 Error_Msg_BC ("OR or ELSE expected");
1475 Error_Msg_BC ("OR or ELSE or THEN ABORT expected");
1478 Select_Node := Error;
1483 -- Here we have a selective accept or an asynchronous select (first
1484 -- token after SELECT is other than a designator token).
1487 -- If we have delay with no guard, could be asynchronous select
1489 if Token = Tok_Delay then
1490 Delay_Stmnt := P_Delay_Statement;
1491 Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
1493 -- Asynchronous select
1495 if Token = Tok_Abort then
1497 Make_Asynchronous_Select (Select_Sloc,
1498 Triggering_Alternative =>
1499 Make_Triggering_Alternative (Stmnt_Sloc,
1500 Triggering_Statement => Delay_Stmnt,
1501 Pragmas_Before => Select_Pragmas,
1502 Statements => Statement_List),
1503 Abortable_Part => P_Abortable_Part);
1508 -- Delay which was not an asynchronous select. Must be a selective
1509 -- accept, and since at least one accept statement is required,
1510 -- we must have at least one OR phrase present.
1513 Alt_List := New_List (
1514 Make_Delay_Alternative (Stmnt_Sloc,
1515 Delay_Statement => Delay_Stmnt,
1516 Pragmas_Before => Select_Pragmas,
1517 Statements => Statement_List));
1519 Alt_Pragmas := P_Pragmas_Opt;
1522 -- If not a delay statement, then must be another possibility for
1523 -- a selective accept alternative, or perhaps a guard is present
1526 Alt_List := New_List;
1527 Alt_Pragmas := Select_Pragmas;
1530 Select_Node := New_Node (N_Selective_Accept, Select_Sloc);
1531 Set_Select_Alternatives (Select_Node, Alt_List);
1533 -- Scan out selective accept alternatives. On entry to this loop,
1534 -- we are just past a SELECT or OR token, and any pragmas that
1535 -- immediately follow the SELECT or OR are in Alt_Pragmas.
1538 if Token = Tok_When then
1540 if Present (Alt_Pragmas) then
1541 Error_Msg_SC ("pragmas may not precede guard");
1545 Cond_Expr := P_Expression_No_Right_Paren;
1547 Alt_Pragmas := P_Pragmas_Opt;
1553 if Token = Tok_Accept then
1554 Alternative := P_Accept_Alternative;
1556 -- Check for junk attempt at asynchronous select using
1557 -- an Accept alternative as the triggering statement
1559 if Token = Tok_Abort
1560 and then Is_Empty_List (Alt_List)
1561 and then No (Cond_Expr)
1564 ("triggering statement must be entry call or delay",
1565 Sloc (Alternative));
1566 Scan; -- past junk ABORT
1567 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
1572 elsif Token = Tok_Delay then
1573 Alternative := P_Delay_Alternative;
1575 elsif Token = Tok_Terminate then
1576 Alternative := P_Terminate_Alternative;
1580 ("select alternative (ACCEPT, ABORT, DELAY) expected");
1581 Alternative := Error;
1583 if Token = Tok_Semicolon then
1584 Scan; -- past junk semicolon
1588 -- THEN ABORT at this stage is just junk
1590 if Token = Tok_Abort then
1591 Error_Msg_SP ("misplaced `THEN ABORT`");
1592 Scan; -- past junk ABORT
1593 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
1598 if Alternative /= Error then
1599 Set_Condition (Alternative, Cond_Expr);
1600 Set_Pragmas_Before (Alternative, Alt_Pragmas);
1601 Append (Alternative, Alt_List);
1604 exit when Token /= Tok_Or;
1608 Alt_Pragmas := P_Pragmas_Opt;
1611 if Token = Tok_Else then
1614 (Select_Node, P_Sequence_Of_Statements (SS_Ortm_Sreq));
1616 if Token = Tok_Or then
1617 Error_Msg_SC ("select alternative cannot follow else part!");
1625 end P_Select_Statement;
1627 -----------------------------
1628 -- 9.7.1 Selective Accept --
1629 -----------------------------
1631 -- Parsed by P_Select_Statement (9.7)
1637 -- Parsed by P_Select_Statement (9.7)
1639 -------------------------------
1640 -- 9.7.1 Select Alternative --
1641 -------------------------------
1643 -- SELECT_ALTERNATIVE ::=
1644 -- ACCEPT_ALTERNATIVE
1645 -- | DELAY_ALTERNATIVE
1646 -- | TERMINATE_ALTERNATIVE
1648 -- Note: the guard preceding a select alternative is included as part
1649 -- of the node generated for a selective accept alternative.
1651 -- Error recovery: cannot raise Error_Resync
1653 -------------------------------
1654 -- 9.7.1 Accept Alternative --
1655 -------------------------------
1657 -- ACCEPT_ALTERNATIVE ::=
1658 -- ACCEPT_STATEMENT [SEQUENCE_OF_STATEMENTS]
1660 -- Error_Recovery: Cannot raise Error_Resync
1662 -- Note: the caller is responsible for setting the Pragmas_Before
1663 -- field of the returned N_Terminate_Alternative node.
1665 function P_Accept_Alternative return Node_Id is
1666 Accept_Alt_Node : Node_Id;
1669 Accept_Alt_Node := New_Node (N_Accept_Alternative, Token_Ptr);
1670 Set_Accept_Statement (Accept_Alt_Node, P_Accept_Statement);
1672 -- Note: the reason that we accept THEN ABORT as a terminator for
1673 -- the sequence of statements is for error recovery which allows
1674 -- for misuse of an accept statement as a triggering statement.
1677 (Accept_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
1678 return Accept_Alt_Node;
1679 end P_Accept_Alternative;
1681 ------------------------------
1682 -- 9.7.1 Delay Alternative --
1683 ------------------------------
1685 -- DELAY_ALTERNATIVE ::=
1686 -- DELAY_STATEMENT [SEQUENCE_OF_STATEMENTS]
1688 -- Error_Recovery: Cannot raise Error_Resync
1690 -- Note: the caller is responsible for setting the Pragmas_Before
1691 -- field of the returned N_Terminate_Alternative node.
1693 function P_Delay_Alternative return Node_Id is
1694 Delay_Alt_Node : Node_Id;
1697 Delay_Alt_Node := New_Node (N_Delay_Alternative, Token_Ptr);
1698 Set_Delay_Statement (Delay_Alt_Node, P_Delay_Statement);
1700 -- Note: the reason that we accept THEN ABORT as a terminator for
1701 -- the sequence of statements is for error recovery which allows
1702 -- for misuse of an accept statement as a triggering statement.
1705 (Delay_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
1706 return Delay_Alt_Node;
1707 end P_Delay_Alternative;
1709 ----------------------------------
1710 -- 9.7.1 Terminate Alternative --
1711 ----------------------------------
1713 -- TERMINATE_ALTERNATIVE ::= terminate;
1715 -- Error_Recovery: Cannot raise Error_Resync
1717 -- Note: the caller is responsible for setting the Pragmas_Before
1718 -- field of the returned N_Terminate_Alternative node.
1720 function P_Terminate_Alternative return Node_Id is
1721 Terminate_Alt_Node : Node_Id;
1724 Terminate_Alt_Node := New_Node (N_Terminate_Alternative, Token_Ptr);
1725 Scan; -- past TERMINATE
1728 -- For all other select alternatives, the sequence of statements
1729 -- after the alternative statement will swallow up any pragmas
1730 -- coming in this position. But the terminate alternative has no
1731 -- sequence of statements, so the pragmas here must be treated
1734 Set_Pragmas_After (Terminate_Alt_Node, P_Pragmas_Opt);
1735 return Terminate_Alt_Node;
1736 end P_Terminate_Alternative;
1738 -----------------------------
1739 -- 9.7.2 Timed Entry Call --
1740 -----------------------------
1742 -- Parsed by P_Select_Statement (9.7)
1744 -----------------------------------
1745 -- 9.7.2 Entry Call Alternative --
1746 -----------------------------------
1748 -- Parsed by P_Select_Statement (9.7)
1750 -----------------------------------
1751 -- 9.7.3 Conditional Entry Call --
1752 -----------------------------------
1754 -- Parsed by P_Select_Statement (9.7)
1756 --------------------------------
1757 -- 9.7.4 Asynchronous Select --
1758 --------------------------------
1760 -- Parsed by P_Select_Statement (9.7)
1762 -----------------------------------
1763 -- 9.7.4 Triggering Alternative --
1764 -----------------------------------
1766 -- Parsed by P_Select_Statement (9.7)
1768 ---------------------------------
1769 -- 9.7.4 Triggering Statement --
1770 ---------------------------------
1772 -- Parsed by P_Select_Statement (9.7)
1774 ---------------------------
1775 -- 9.7.4 Abortable Part --
1776 ---------------------------
1778 -- ABORTABLE_PART ::= SEQUENCE_OF_STATEMENTS
1780 -- The caller has verified that THEN ABORT is present, and Token is
1781 -- pointing to the ABORT on entry (or if not, then we have an error)
1783 -- Error recovery: cannot raise Error_Resync
1785 function P_Abortable_Part return Node_Id is
1786 Abortable_Part_Node : Node_Id;
1789 Abortable_Part_Node := New_Node (N_Abortable_Part, Token_Ptr);
1790 T_Abort; -- scan past ABORT
1792 if Ada_Version = Ada_83 then
1793 Error_Msg_SP ("(Ada 83) asynchronous select not allowed!");
1796 Set_Statements (Abortable_Part_Node, P_Sequence_Of_Statements (SS_Sreq));
1797 return Abortable_Part_Node;
1798 end P_Abortable_Part;
1800 --------------------------
1801 -- 9.8 Abort Statement --
1802 --------------------------
1804 -- ABORT_STATEMENT ::= abort task_NAME {, task_NAME};
1806 -- The caller has checked that the initial token is ABORT
1808 -- Error recovery: cannot raise Error_Resync
1810 function P_Abort_Statement return Node_Id is
1811 Abort_Node : Node_Id;
1814 Abort_Node := New_Node (N_Abort_Statement, Token_Ptr);
1816 Set_Names (Abort_Node, New_List);
1819 Append (P_Name, Names (Abort_Node));
1820 exit when Token /= Tok_Comma;
1826 end P_Abort_Statement;