1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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 ("task 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");
500 if Token = Tok_Private then
502 ("PRIVATE not allowed in protected type declaration");
506 Set_Protected_Definition (Protected_Node, P_Protected_Definition);
507 return Protected_Node;
511 -------------------------------------
512 -- 9.4 Protected Type Declaration --
513 -------------------------------------
515 -- Parsed by P_Protected (9.4)
517 ---------------------------------------
518 -- 9.4 Single Protected Declaration --
519 ---------------------------------------
521 -- Parsed by P_Protected (9.4)
523 -------------------------------
524 -- 9.4 Protected Definition --
525 -------------------------------
527 -- PROTECTED_DEFINITION ::=
528 -- {PROTECTED_OPERATION_DECLARATION}
530 -- {PROTECTED_ELEMENT_DECLARATION}]
531 -- end [protected_IDENTIFIER]
533 -- PROTECTED_ELEMENT_DECLARATION ::=
534 -- PROTECTED_OPERATION_DECLARATION
535 -- | COMPONENT_DECLARATION
537 -- The caller has already established the scope stack entry
539 -- Error recovery: cannot raise Error_Resync
541 function P_Protected_Definition return Node_Id is
546 Def_Node := New_Node (N_Protected_Definition, Token_Ptr);
548 -- Get rid of active SIS entry from outer scope. This means we will
549 -- miss some nested cases, but it doesn't seem worth the effort. See
550 -- discussion in Par for further details
552 SIS_Entry_Active := False;
554 -- Loop to scan visible declarations (protected operation declarations)
556 Set_Visible_Declarations (Def_Node, New_List);
559 Item_Node := P_Protected_Operation_Declaration_Opt;
560 exit when No (Item_Node);
561 Append (Item_Node, Visible_Declarations (Def_Node));
564 -- Deal with PRIVATE part (including graceful handling
565 -- of multiple PRIVATE parts).
567 Private_Loop : while Token = Tok_Private loop
568 if No (Private_Declarations (Def_Node)) then
569 Set_Private_Declarations (Def_Node, New_List);
571 Error_Msg_SC ("duplicate private part");
574 Scan; -- past PRIVATE
576 Declaration_Loop : loop
577 if Token = Tok_Identifier then
578 P_Component_Items (Private_Declarations (Def_Node));
580 Item_Node := P_Protected_Operation_Declaration_Opt;
581 exit Declaration_Loop when No (Item_Node);
582 Append (Item_Node, Private_Declarations (Def_Node));
584 end loop Declaration_Loop;
585 end loop Private_Loop;
587 End_Statements (Def_Node);
589 end P_Protected_Definition;
591 ------------------------------------------
592 -- 9.4 Protected Operation Declaration --
593 ------------------------------------------
595 -- PROTECTED_OPERATION_DECLARATION ::=
596 -- SUBPROGRAM_DECLARATION
597 -- | ENTRY_DECLARATION
598 -- | REPRESENTATION_CLAUSE
600 -- Error recovery: cannot raise Error_Resync
602 -- Note: a pragma can also be returned in this position
604 -- We are not currently permitting representation clauses to appear as
605 -- protected operation declarations, do we have to rethink this???
607 function P_Protected_Operation_Declaration_Opt return Node_Id is
611 function P_Entry_Or_Subprogram_With_Indicator return Node_Id;
612 -- Ada 2005 (AI-397): Parse an entry or a subprogram with an overriding
613 -- indicator. The caller has checked that the initial token is NOT or
616 ------------------------------------------
617 -- P_Entry_Or_Subprogram_With_Indicator --
618 ------------------------------------------
620 function P_Entry_Or_Subprogram_With_Indicator return Node_Id is
621 Decl : Node_Id := Error;
622 Is_Overriding : Boolean := False;
623 Not_Overriding : Boolean := False;
626 if Token = Tok_Not then
629 if Token = Tok_Overriding then
630 Scan; -- past OVERRIDING
631 Not_Overriding := True;
633 Error_Msg_SC ("OVERRIDING expected!");
637 Scan; -- past OVERRIDING
638 Is_Overriding := True;
641 if (Is_Overriding or else Not_Overriding) then
642 if Ada_Version < Ada_05 then
643 Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
644 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
646 elsif Token = Tok_Entry then
647 Decl := P_Entry_Declaration;
649 Set_Must_Override (Decl, Is_Overriding);
650 Set_Must_Not_Override (Decl, Not_Overriding);
652 elsif Token = Tok_Function or else Token = Tok_Procedure then
653 Decl := P_Subprogram (Pf_Decl);
655 Set_Must_Override (Specification (Decl), Is_Overriding);
656 Set_Must_Not_Override (Specification (Decl), Not_Overriding);
659 Error_Msg_SC ("ENTRY, FUNCTION or PROCEDURE expected!");
664 end P_Entry_Or_Subprogram_With_Indicator;
666 -- Start of processing for P_Protected_Operation_Declaration_Opt
669 -- This loop runs more than once only when a junk declaration
673 if Token = Tok_Pragma then
676 elsif Token = Tok_Not or else Token = Tok_Overriding then
677 return P_Entry_Or_Subprogram_With_Indicator;
679 elsif Token = Tok_Entry then
680 return P_Entry_Declaration;
682 elsif Token = Tok_Function or else Token = Tok_Procedure then
683 return P_Subprogram (Pf_Decl);
685 elsif Token = Tok_Identifier then
688 Skip_Declaration (L);
690 if Nkind (First (L)) = N_Object_Declaration then
692 ("component must be declared in private part of " &
693 "protected type", P);
696 ("illegal declaration in protected definition", P);
699 elsif Token in Token_Class_Declk then
700 Error_Msg_SC ("illegal declaration in protected definition");
701 Resync_Past_Semicolon;
703 -- Return now to avoid cascaded messages if next declaration
704 -- is a valid component declaration.
708 elsif Token = Tok_For then
710 ("representation clause not allowed in protected definition");
711 Resync_Past_Semicolon;
717 end P_Protected_Operation_Declaration_Opt;
719 -----------------------------------
720 -- 9.4 Protected Operation Item --
721 -----------------------------------
723 -- PROTECTED_OPERATION_ITEM ::=
724 -- SUBPROGRAM_DECLARATION
727 -- | REPRESENTATION_CLAUSE
729 -- This procedure parses and returns a list of protected operation items
731 -- We are not currently permitting representation clauses to appear
732 -- as protected operation items, do we have to rethink this???
734 function P_Protected_Operation_Items return List_Id is
738 Item_List := New_List;
741 if Token = Tok_Entry or else Bad_Spelling_Of (Tok_Entry) then
742 Append (P_Entry_Body, Item_List);
744 elsif Token = Tok_Function or else Bad_Spelling_Of (Tok_Function)
746 Token = Tok_Procedure or else Bad_Spelling_Of (Tok_Procedure)
748 Append (P_Subprogram (Pf_Decl_Pbod), Item_List);
750 elsif Token = Tok_Pragma or else Bad_Spelling_Of (Tok_Pragma) then
751 P_Pragmas_Opt (Item_List);
753 elsif Token = Tok_Private or else Bad_Spelling_Of (Tok_Private) then
754 Error_Msg_SC ("PRIVATE not allowed in protected body");
755 Scan; -- past PRIVATE
757 elsif Token = Tok_Identifier then
759 ("all components must be declared in spec!");
760 Resync_Past_Semicolon;
762 elsif Token in Token_Class_Declk then
763 Error_Msg_SC ("this declaration not allowed in protected body");
764 Resync_Past_Semicolon;
772 end P_Protected_Operation_Items;
774 ------------------------------
775 -- 9.5.2 Entry Declaration --
776 ------------------------------
778 -- ENTRY_DECLARATION ::=
779 -- [OVERRIDING_INDICATOR]
780 -- entry DEFINING_IDENTIFIER [(DISCRETE_SUBTYPE_DEFINITION)]
781 -- PARAMETER_PROFILE;
783 -- The caller has checked that the initial token is ENTRY, NOT or
786 -- Error recovery: cannot raise Error_Resync
788 function P_Entry_Declaration return Node_Id is
790 Scan_State : Saved_Scan_State;
792 -- Flags for optional overriding indication. Two flags are needed,
793 -- to distinguish positive and negative overriding indicators from
794 -- the absence of any indicator.
796 Is_Overriding : Boolean := False;
797 Not_Overriding : Boolean := False;
800 -- Ada 2005 (AI-397): Scan leading overriding indicator
802 if Token = Tok_Not then
805 if Token = Tok_Overriding then
806 Scan; -- part OVERRIDING
807 Not_Overriding := True;
809 Error_Msg_SC ("OVERRIDING expected!");
812 elsif Token = Tok_Overriding then
813 Scan; -- part OVERRIDING
814 Is_Overriding := True;
817 if (Is_Overriding or else Not_Overriding) then
818 if Ada_Version < Ada_05 then
819 Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
820 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
822 elsif Token /= Tok_Entry then
823 Error_Msg_SC ("ENTRY expected!");
827 Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
830 Set_Defining_Identifier
831 (Decl_Node, P_Defining_Identifier (C_Left_Paren_Semicolon));
833 -- If left paren, could be (Discrete_Subtype_Definition) or Formal_Part
835 if Token = Tok_Left_Paren then
838 -- If identifier after left paren, could still be either
840 if Token = Tok_Identifier then
841 Save_Scan_State (Scan_State); -- at Id
844 -- If comma or colon after Id, must be Formal_Part
846 if Token = Tok_Comma or else Token = Tok_Colon then
847 Restore_Scan_State (Scan_State); -- to Id
848 Set_Parameter_Specifications (Decl_Node, P_Formal_Part);
850 -- Else if Id wi no comma or colon, must be discrete subtype defn
853 Restore_Scan_State (Scan_State); -- to Id
854 Set_Discrete_Subtype_Definition
855 (Decl_Node, P_Discrete_Subtype_Definition);
857 Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
860 -- If no Id, must be discrete subtype definition
863 Set_Discrete_Subtype_Definition
864 (Decl_Node, P_Discrete_Subtype_Definition);
866 Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
870 if Is_Overriding then
871 Set_Must_Override (Decl_Node);
872 elsif Not_Overriding then
873 Set_Must_Not_Override (Decl_Node);
876 -- Error recovery check for illegal return
878 if Token = Tok_Return then
879 Error_Msg_SC ("entry cannot have return value!");
881 Discard_Junk_Node (P_Subtype_Indication);
884 -- Error recovery check for improper use of entry barrier in spec
886 if Token = Tok_When then
887 Error_Msg_SC ("barrier not allowed here (belongs in body)");
889 Discard_Junk_Node (P_Expression_No_Right_Paren);
897 Resync_Past_Semicolon;
899 end P_Entry_Declaration;
901 -----------------------------
902 -- 9.5.2 Accept Statement --
903 -----------------------------
905 -- ACCEPT_STATEMENT ::=
906 -- accept entry_DIRECT_NAME
907 -- [(ENTRY_INDEX)] PARAMETER_PROFILE [do
908 -- HANDLED_SEQUENCE_OF_STATEMENTS
909 -- end [entry_IDENTIFIER]];
911 -- The caller has checked that the initial token is ACCEPT
913 -- Error recovery: cannot raise Error_Resync. If an error occurs, the
914 -- scan is resynchronized past the next semicolon and control returns.
916 function P_Accept_Statement return Node_Id is
917 Scan_State : Saved_Scan_State;
918 Accept_Node : Node_Id;
923 Scope.Table (Scope.Last).Sloc := Token_Ptr;
924 Scope.Table (Scope.Last).Ecol := Start_Column;
926 Accept_Node := New_Node (N_Accept_Statement, Token_Ptr);
928 Scope.Table (Scope.Last).Labl := Token_Node;
930 Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
932 -- Left paren could be (Entry_Index) or Formal_Part, determine which
934 if Token = Tok_Left_Paren then
935 Save_Scan_State (Scan_State); -- at left paren
936 Scan; -- past left paren
938 -- If first token after left paren not identifier, then Entry_Index
940 if Token /= Tok_Identifier then
941 Set_Entry_Index (Accept_Node, P_Expression);
943 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
945 -- First token after left paren is identifier, could be either case
947 else -- Token = Tok_Identifier
948 Scan; -- past identifier
950 -- If identifier followed by comma or colon, must be Formal_Part
952 if Token = Tok_Comma or else Token = Tok_Colon then
953 Restore_Scan_State (Scan_State); -- to left paren
954 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
956 -- If identifier not followed by comma/colon, must be entry index
959 Restore_Scan_State (Scan_State); -- to left paren
960 Scan; -- past left paren (again!)
961 Set_Entry_Index (Accept_Node, P_Expression);
963 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
968 -- Scan out DO if present
970 if Token = Tok_Do then
971 Scope.Table (Scope.Last).Etyp := E_Name;
972 Scope.Table (Scope.Last).Lreq := False;
974 Hand_Seq := P_Handled_Sequence_Of_Statements;
975 Set_Handled_Statement_Sequence (Accept_Node, Hand_Seq);
976 End_Statements (Handled_Statement_Sequence (Accept_Node));
978 -- Exception handlers not allowed in Ada 95 node
980 if Present (Exception_Handlers (Hand_Seq)) then
981 if Ada_Version = Ada_83 then
983 ("(Ada 83) exception handlers in accept not allowed",
984 First_Non_Pragma (Exception_Handlers (Hand_Seq)));
989 Pop_Scope_Stack; -- discard unused entry
995 -- If error, resynchronize past semicolon
999 Resync_Past_Semicolon;
1000 Pop_Scope_Stack; -- discard unused entry
1003 end P_Accept_Statement;
1005 ------------------------
1006 -- 9.5.2 Entry Index --
1007 ------------------------
1009 -- Parsed by P_Expression (4.4)
1011 -----------------------
1012 -- 9.5.2 Entry Body --
1013 -----------------------
1016 -- entry DEFINING_IDENTIFIER ENTRY_BODY_FORMAL_PART ENTRY_BARRIER is
1019 -- HANDLED_SEQUENCE_OF_STATEMENTS
1020 -- end [entry_IDENTIFIER];
1022 -- The caller has checked that the initial token is ENTRY
1024 -- Error_Recovery: cannot raise Error_Resync
1026 function P_Entry_Body return Node_Id is
1027 Entry_Node : Node_Id;
1028 Formal_Part_Node : Node_Id;
1029 Name_Node : Node_Id;
1033 Entry_Node := New_Node (N_Entry_Body, Token_Ptr);
1036 Scope.Table (Scope.Last).Ecol := Start_Column;
1037 Scope.Table (Scope.Last).Lreq := False;
1038 Scope.Table (Scope.Last).Etyp := E_Name;
1040 Name_Node := P_Defining_Identifier;
1041 Set_Defining_Identifier (Entry_Node, Name_Node);
1042 Scope.Table (Scope.Last).Labl := Name_Node;
1044 Formal_Part_Node := P_Entry_Body_Formal_Part;
1045 Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node);
1047 Set_Condition (Formal_Part_Node, P_Entry_Barrier);
1048 Parse_Decls_Begin_End (Entry_Node);
1052 -----------------------------------
1053 -- 9.5.2 Entry Body Formal Part --
1054 -----------------------------------
1056 -- ENTRY_BODY_FORMAL_PART ::=
1057 -- [(ENTRY_INDEX_SPECIFICATION)] [PARAMETER_PART]
1059 -- Error_Recovery: cannot raise Error_Resync
1061 function P_Entry_Body_Formal_Part return Node_Id is
1062 Fpart_Node : Node_Id;
1063 Scan_State : Saved_Scan_State;
1066 Fpart_Node := New_Node (N_Entry_Body_Formal_Part, Token_Ptr);
1068 -- See if entry index specification present, and if so parse it
1070 if Token = Tok_Left_Paren then
1071 Save_Scan_State (Scan_State); -- at left paren
1072 Scan; -- past left paren
1074 if Token = Tok_For then
1075 Set_Entry_Index_Specification
1076 (Fpart_Node, P_Entry_Index_Specification);
1079 Restore_Scan_State (Scan_State); -- to left paren
1082 -- Check for (common?) case of left paren omitted before FOR. This
1083 -- is a tricky case, because the corresponding missing left paren
1084 -- can cause real havoc if a formal part is present which gets
1085 -- treated as part of the discrete subtype definition of the
1086 -- entry index specification, so just give error and resynchronize
1088 elsif Token = Tok_For then
1089 T_Left_Paren; -- to give error message
1093 Set_Parameter_Specifications (Fpart_Node, P_Parameter_Profile);
1095 end P_Entry_Body_Formal_Part;
1097 --------------------------
1098 -- 9.5.2 Entry Barrier --
1099 --------------------------
1101 -- ENTRY_BARRIER ::= when CONDITION
1103 -- Error_Recovery: cannot raise Error_Resync
1105 function P_Entry_Barrier return Node_Id is
1109 if Token = Tok_When then
1111 Bnode := P_Expression_No_Right_Paren;
1113 if Token = Tok_Colon_Equal then
1114 Error_Msg_SC ("|"":="" should be ""=""");
1116 Bnode := P_Expression_No_Right_Paren;
1120 T_When; -- to give error message
1126 end P_Entry_Barrier;
1128 --------------------------------------
1129 -- 9.5.2 Entry Index Specification --
1130 --------------------------------------
1132 -- ENTRY_INDEX_SPECIFICATION ::=
1133 -- for DEFINING_IDENTIFIER in DISCRETE_SUBTYPE_DEFINITION
1135 -- Error recovery: can raise Error_Resync
1137 function P_Entry_Index_Specification return Node_Id is
1138 Iterator_Node : Node_Id;
1141 Iterator_Node := New_Node (N_Entry_Index_Specification, Token_Ptr);
1143 Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier (C_In));
1145 Set_Discrete_Subtype_Definition
1146 (Iterator_Node, P_Discrete_Subtype_Definition);
1147 return Iterator_Node;
1148 end P_Entry_Index_Specification;
1150 ---------------------------------
1151 -- 9.5.3 Entry Call Statement --
1152 ---------------------------------
1154 -- Parsed by P_Name (4.1). Within a select, an entry call is parsed
1155 -- by P_Select_Statement (9.7)
1157 ------------------------------
1158 -- 9.5.4 Requeue Statement --
1159 ------------------------------
1161 -- REQUEUE_STATEMENT ::= requeue entry_NAME [with abort];
1163 -- The caller has checked that the initial token is requeue
1165 -- Error recovery: can raise Error_Resync
1167 function P_Requeue_Statement return Node_Id is
1168 Requeue_Node : Node_Id;
1171 Requeue_Node := New_Node (N_Requeue_Statement, Token_Ptr);
1172 Scan; -- past REQUEUE
1173 Set_Name (Requeue_Node, P_Name);
1175 if Token = Tok_With then
1178 Set_Abort_Present (Requeue_Node, True);
1182 return Requeue_Node;
1183 end P_Requeue_Statement;
1185 --------------------------
1186 -- 9.6 Delay Statement --
1187 --------------------------
1189 -- DELAY_STATEMENT ::=
1190 -- DELAY_UNTIL_STATEMENT
1191 -- | DELAY_RELATIVE_STATEMENT
1193 -- The caller has checked that the initial token is DELAY
1195 -- Error recovery: cannot raise Error_Resync
1197 function P_Delay_Statement return Node_Id is
1201 -- The following check for delay until misused in Ada 83 doesn't catch
1202 -- all cases, but it's good enough to catch most of them!
1204 if Token_Name = Name_Until then
1205 Check_95_Keyword (Tok_Until, Tok_Left_Paren);
1206 Check_95_Keyword (Tok_Until, Tok_Identifier);
1209 if Token = Tok_Until then
1210 return P_Delay_Until_Statement;
1212 return P_Delay_Relative_Statement;
1214 end P_Delay_Statement;
1216 --------------------------------
1217 -- 9.6 Delay Until Statement --
1218 --------------------------------
1220 -- DELAY_UNTIL_STATEMENT ::= delay until delay_EXPRESSION;
1222 -- The caller has checked that the initial token is DELAY, scanned it
1223 -- out and checked that the current token is UNTIL
1225 -- Error recovery: cannot raise Error_Resync
1227 function P_Delay_Until_Statement return Node_Id is
1228 Delay_Node : Node_Id;
1231 Delay_Node := New_Node (N_Delay_Until_Statement, Prev_Token_Ptr);
1233 Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
1236 end P_Delay_Until_Statement;
1238 -----------------------------------
1239 -- 9.6 Delay Relative Statement --
1240 -----------------------------------
1242 -- DELAY_RELATIVE_STATEMENT ::= delay delay_EXPRESSION;
1244 -- The caller has checked that the initial token is DELAY, scanned it
1245 -- out and determined that the current token is not UNTIL
1247 -- Error recovery: cannot raise Error_Resync
1249 function P_Delay_Relative_Statement return Node_Id is
1250 Delay_Node : Node_Id;
1253 Delay_Node := New_Node (N_Delay_Relative_Statement, Prev_Token_Ptr);
1254 Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
1255 Check_Simple_Expression_In_Ada_83 (Expression (Delay_Node));
1258 end P_Delay_Relative_Statement;
1260 ---------------------------
1261 -- 9.7 Select Statement --
1262 ---------------------------
1264 -- SELECT_STATEMENT ::=
1266 -- | TIMED_ENTRY_CALL
1267 -- | CONDITIONAL_ENTRY_CALL
1268 -- | ASYNCHRONOUS_SELECT
1270 -- SELECTIVE_ACCEPT ::=
1273 -- SELECT_ALTERNATIVE
1276 -- SELECT_ALTERNATIVE
1278 -- SEQUENCE_OF_STATEMENTS]
1281 -- GUARD ::= when CONDITION =>
1283 -- Note: the guard preceding a select alternative is included as part
1284 -- of the node generated for a selective accept alternative.
1286 -- SELECT_ALTERNATIVE ::=
1287 -- ACCEPT_ALTERNATIVE
1288 -- | DELAY_ALTERNATIVE
1289 -- | TERMINATE_ALTERNATIVE
1291 -- TIMED_ENTRY_CALL ::=
1293 -- ENTRY_CALL_ALTERNATIVE
1295 -- DELAY_ALTERNATIVE
1298 -- CONDITIONAL_ENTRY_CALL ::=
1300 -- ENTRY_CALL_ALTERNATIVE
1302 -- SEQUENCE_OF_STATEMENTS
1305 -- ENTRY_CALL_ALTERNATIVE ::=
1306 -- ENTRY_CALL_STATEMENT [SEQUENCE_OF_STATEMENTS]
1308 -- ASYNCHRONOUS_SELECT ::=
1310 -- TRIGGERING_ALTERNATIVE
1315 -- TRIGGERING_ALTERNATIVE ::=
1316 -- TRIGGERING_STATEMENT [SEQUENCE_OF_STATEMENTS]
1318 -- TRIGGERING_STATEMENT ::= ENTRY_CALL_STATEMENT | DELAY_STATEMENT
1320 -- The caller has checked that the initial token is SELECT
1322 -- Error recovery: can raise Error_Resync
1324 function P_Select_Statement return Node_Id is
1325 Select_Node : Node_Id;
1326 Select_Sloc : Source_Ptr;
1327 Stmnt_Sloc : Source_Ptr;
1328 Ecall_Node : Node_Id;
1329 Alternative : Node_Id;
1330 Select_Pragmas : List_Id;
1331 Alt_Pragmas : List_Id;
1332 Statement_List : List_Id;
1334 Cond_Expr : Node_Id;
1335 Delay_Stmnt : Node_Id;
1339 Scope.Table (Scope.Last).Etyp := E_Select;
1340 Scope.Table (Scope.Last).Ecol := Start_Column;
1341 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1342 Scope.Table (Scope.Last).Labl := Error;
1344 Select_Sloc := Token_Ptr;
1345 Scan; -- past SELECT
1346 Stmnt_Sloc := Token_Ptr;
1347 Select_Pragmas := P_Pragmas_Opt;
1349 -- If first token after select is designator, then we have an entry
1350 -- call, which must be the start of a conditional entry call, timed
1351 -- entry call or asynchronous select
1353 if Token in Token_Class_Desig then
1355 -- Scan entry call statement
1358 Ecall_Node := P_Name;
1360 -- ?? The following two clauses exactly parallel code in ch5
1361 -- and should be commoned sometime
1363 if Nkind (Ecall_Node) = N_Indexed_Component then
1365 Prefix_Node : constant Node_Id := Prefix (Ecall_Node);
1366 Exprs_Node : constant List_Id := Expressions (Ecall_Node);
1369 Change_Node (Ecall_Node, N_Procedure_Call_Statement);
1370 Set_Name (Ecall_Node, Prefix_Node);
1371 Set_Parameter_Associations (Ecall_Node, Exprs_Node);
1374 elsif Nkind (Ecall_Node) = N_Function_Call then
1376 Fname_Node : constant Node_Id := Name (Ecall_Node);
1377 Params_List : constant List_Id :=
1378 Parameter_Associations (Ecall_Node);
1381 Change_Node (Ecall_Node, N_Procedure_Call_Statement);
1382 Set_Name (Ecall_Node, Fname_Node);
1383 Set_Parameter_Associations (Ecall_Node, Params_List);
1386 elsif Nkind (Ecall_Node) = N_Identifier
1387 or else Nkind (Ecall_Node) = N_Selected_Component
1389 -- Case of a call to a parameterless entry
1392 C_Node : constant Node_Id :=
1393 New_Node (N_Procedure_Call_Statement, Stmnt_Sloc);
1395 Set_Name (C_Node, Ecall_Node);
1396 Set_Parameter_Associations (C_Node, No_List);
1397 Ecall_Node := C_Node;
1404 when Error_Resync =>
1405 Resync_Past_Semicolon;
1409 Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
1411 -- OR follows, we have a timed entry call
1413 if Token = Tok_Or then
1415 Alt_Pragmas := P_Pragmas_Opt;
1417 Select_Node := New_Node (N_Timed_Entry_Call, Select_Sloc);
1418 Set_Entry_Call_Alternative (Select_Node,
1419 Make_Entry_Call_Alternative (Stmnt_Sloc,
1420 Entry_Call_Statement => Ecall_Node,
1421 Pragmas_Before => Select_Pragmas,
1422 Statements => Statement_List));
1424 -- Only possibility is delay alternative. If we have anything
1425 -- else, give message, and treat as conditional entry call.
1427 if Token /= Tok_Delay then
1429 ("only allowed alternative in timed entry call is delay!");
1430 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
1431 Set_Delay_Alternative (Select_Node, Error);
1434 Set_Delay_Alternative (Select_Node, P_Delay_Alternative);
1436 (Delay_Alternative (Select_Node), Alt_Pragmas);
1439 -- ELSE follows, we have a conditional entry call
1441 elsif Token = Tok_Else then
1443 Select_Node := New_Node (N_Conditional_Entry_Call, Select_Sloc);
1445 Set_Entry_Call_Alternative (Select_Node,
1446 Make_Entry_Call_Alternative (Stmnt_Sloc,
1447 Entry_Call_Statement => Ecall_Node,
1448 Pragmas_Before => Select_Pragmas,
1449 Statements => Statement_List));
1452 (Select_Node, P_Sequence_Of_Statements (SS_Sreq));
1454 -- Only remaining case is THEN ABORT (asynchronous select)
1456 elsif Token = Tok_Abort then
1458 Make_Asynchronous_Select (Select_Sloc,
1459 Triggering_Alternative =>
1460 Make_Triggering_Alternative (Stmnt_Sloc,
1461 Triggering_Statement => Ecall_Node,
1462 Pragmas_Before => Select_Pragmas,
1463 Statements => Statement_List),
1464 Abortable_Part => P_Abortable_Part);
1469 if Ada_Version = Ada_83 then
1470 Error_Msg_BC ("OR or ELSE expected");
1472 Error_Msg_BC ("OR or ELSE or THEN ABORT expected");
1475 Select_Node := Error;
1480 -- Here we have a selective accept or an an asynchronous select (first
1481 -- token after SELECT is other than a designator token).
1484 -- If we have delay with no guard, could be asynchronous select
1486 if Token = Tok_Delay then
1487 Delay_Stmnt := P_Delay_Statement;
1488 Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
1490 -- Asynchronous select
1492 if Token = Tok_Abort then
1494 Make_Asynchronous_Select (Select_Sloc,
1495 Triggering_Alternative =>
1496 Make_Triggering_Alternative (Stmnt_Sloc,
1497 Triggering_Statement => Delay_Stmnt,
1498 Pragmas_Before => Select_Pragmas,
1499 Statements => Statement_List),
1500 Abortable_Part => P_Abortable_Part);
1505 -- Delay which was not an asynchronous select. Must be a selective
1506 -- accept, and since at least one accept statement is required,
1507 -- we must have at least one OR phrase present.
1510 Alt_List := New_List (
1511 Make_Delay_Alternative (Stmnt_Sloc,
1512 Delay_Statement => Delay_Stmnt,
1513 Pragmas_Before => Select_Pragmas,
1514 Statements => Statement_List));
1516 Alt_Pragmas := P_Pragmas_Opt;
1519 -- If not a delay statement, then must be another possibility for
1520 -- a selective accept alternative, or perhaps a guard is present
1523 Alt_List := New_List;
1524 Alt_Pragmas := Select_Pragmas;
1527 Select_Node := New_Node (N_Selective_Accept, Select_Sloc);
1528 Set_Select_Alternatives (Select_Node, Alt_List);
1530 -- Scan out selective accept alternatives. On entry to this loop,
1531 -- we are just past a SELECT or OR token, and any pragmas that
1532 -- immediately follow the SELECT or OR are in Alt_Pragmas.
1535 if Token = Tok_When then
1537 if Present (Alt_Pragmas) then
1538 Error_Msg_SC ("pragmas may not precede guard");
1542 Cond_Expr := P_Expression_No_Right_Paren;
1544 Alt_Pragmas := P_Pragmas_Opt;
1550 if Token = Tok_Accept then
1551 Alternative := P_Accept_Alternative;
1553 -- Check for junk attempt at asynchronous select using
1554 -- an Accept alternative as the triggering statement
1556 if Token = Tok_Abort
1557 and then Is_Empty_List (Alt_List)
1558 and then No (Cond_Expr)
1561 ("triggering statement must be entry call or delay",
1562 Sloc (Alternative));
1563 Scan; -- past junk ABORT
1564 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
1569 elsif Token = Tok_Delay then
1570 Alternative := P_Delay_Alternative;
1572 elsif Token = Tok_Terminate then
1573 Alternative := P_Terminate_Alternative;
1577 ("select alternative (ACCEPT, ABORT, DELAY) expected");
1578 Alternative := Error;
1580 if Token = Tok_Semicolon then
1581 Scan; -- past junk semicolon
1585 -- THEN ABORT at this stage is just junk
1587 if Token = Tok_Abort then
1588 Error_Msg_SP ("misplaced `THEN ABORT`");
1589 Scan; -- past junk ABORT
1590 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
1595 if Alternative /= Error then
1596 Set_Condition (Alternative, Cond_Expr);
1597 Set_Pragmas_Before (Alternative, Alt_Pragmas);
1598 Append (Alternative, Alt_List);
1601 exit when Token /= Tok_Or;
1605 Alt_Pragmas := P_Pragmas_Opt;
1608 if Token = Tok_Else then
1611 (Select_Node, P_Sequence_Of_Statements (SS_Ortm_Sreq));
1613 if Token = Tok_Or then
1614 Error_Msg_SC ("select alternative cannot follow else part!");
1622 end P_Select_Statement;
1624 -----------------------------
1625 -- 9.7.1 Selective Accept --
1626 -----------------------------
1628 -- Parsed by P_Select_Statement (9.7)
1634 -- Parsed by P_Select_Statement (9.7)
1636 -------------------------------
1637 -- 9.7.1 Select Alternative --
1638 -------------------------------
1640 -- SELECT_ALTERNATIVE ::=
1641 -- ACCEPT_ALTERNATIVE
1642 -- | DELAY_ALTERNATIVE
1643 -- | TERMINATE_ALTERNATIVE
1645 -- Note: the guard preceding a select alternative is included as part
1646 -- of the node generated for a selective accept alternative.
1648 -- Error recovery: cannot raise Error_Resync
1650 -------------------------------
1651 -- 9.7.1 Accept Alternative --
1652 -------------------------------
1654 -- ACCEPT_ALTERNATIVE ::=
1655 -- ACCEPT_STATEMENT [SEQUENCE_OF_STATEMENTS]
1657 -- Error_Recovery: Cannot raise Error_Resync
1659 -- Note: the caller is responsible for setting the Pragmas_Before
1660 -- field of the returned N_Terminate_Alternative node.
1662 function P_Accept_Alternative return Node_Id is
1663 Accept_Alt_Node : Node_Id;
1666 Accept_Alt_Node := New_Node (N_Accept_Alternative, Token_Ptr);
1667 Set_Accept_Statement (Accept_Alt_Node, P_Accept_Statement);
1669 -- Note: the reason that we accept THEN ABORT as a terminator for
1670 -- the sequence of statements is for error recovery which allows
1671 -- for misuse of an accept statement as a triggering statememt.
1674 (Accept_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
1675 return Accept_Alt_Node;
1676 end P_Accept_Alternative;
1678 ------------------------------
1679 -- 9.7.1 Delay Alternative --
1680 ------------------------------
1682 -- DELAY_ALTERNATIVE ::=
1683 -- DELAY_STATEMENT [SEQUENCE_OF_STATEMENTS]
1685 -- Error_Recovery: Cannot raise Error_Resync
1687 -- Note: the caller is responsible for setting the Pragmas_Before
1688 -- field of the returned N_Terminate_Alternative node.
1690 function P_Delay_Alternative return Node_Id is
1691 Delay_Alt_Node : Node_Id;
1694 Delay_Alt_Node := New_Node (N_Delay_Alternative, Token_Ptr);
1695 Set_Delay_Statement (Delay_Alt_Node, P_Delay_Statement);
1697 -- Note: the reason that we accept THEN ABORT as a terminator for
1698 -- the sequence of statements is for error recovery which allows
1699 -- for misuse of an accept statement as a triggering statememt.
1702 (Delay_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
1703 return Delay_Alt_Node;
1704 end P_Delay_Alternative;
1706 ----------------------------------
1707 -- 9.7.1 Terminate Alternative --
1708 ----------------------------------
1710 -- TERMINATE_ALTERNATIVE ::= terminate;
1712 -- Error_Recovery: Cannot raise Error_Resync
1714 -- Note: the caller is responsible for setting the Pragmas_Before
1715 -- field of the returned N_Terminate_Alternative node.
1717 function P_Terminate_Alternative return Node_Id is
1718 Terminate_Alt_Node : Node_Id;
1721 Terminate_Alt_Node := New_Node (N_Terminate_Alternative, Token_Ptr);
1722 Scan; -- past TERMINATE
1725 -- For all other select alternatives, the sequence of statements
1726 -- after the alternative statement will swallow up any pragmas
1727 -- coming in this position. But the terminate alternative has no
1728 -- sequence of statements, so the pragmas here must be treated
1731 Set_Pragmas_After (Terminate_Alt_Node, P_Pragmas_Opt);
1732 return Terminate_Alt_Node;
1733 end P_Terminate_Alternative;
1735 -----------------------------
1736 -- 9.7.2 Timed Entry Call --
1737 -----------------------------
1739 -- Parsed by P_Select_Statement (9.7)
1741 -----------------------------------
1742 -- 9.7.2 Entry Call Alternative --
1743 -----------------------------------
1745 -- Parsed by P_Select_Statement (9.7)
1747 -----------------------------------
1748 -- 9.7.3 Conditional Entry Call --
1749 -----------------------------------
1751 -- Parsed by P_Select_Statement (9.7)
1753 --------------------------------
1754 -- 9.7.4 Asynchronous Select --
1755 --------------------------------
1757 -- Parsed by P_Select_Statement (9.7)
1759 -----------------------------------
1760 -- 9.7.4 Triggering Alternative --
1761 -----------------------------------
1763 -- Parsed by P_Select_Statement (9.7)
1765 ---------------------------------
1766 -- 9.7.4 Triggering Statement --
1767 ---------------------------------
1769 -- Parsed by P_Select_Statement (9.7)
1771 ---------------------------
1772 -- 9.7.4 Abortable Part --
1773 ---------------------------
1775 -- ABORTABLE_PART ::= SEQUENCE_OF_STATEMENTS
1777 -- The caller has verified that THEN ABORT is present, and Token is
1778 -- pointing to the ABORT on entry (or if not, then we have an error)
1780 -- Error recovery: cannot raise Error_Resync
1782 function P_Abortable_Part return Node_Id is
1783 Abortable_Part_Node : Node_Id;
1786 Abortable_Part_Node := New_Node (N_Abortable_Part, Token_Ptr);
1787 T_Abort; -- scan past ABORT
1789 if Ada_Version = Ada_83 then
1790 Error_Msg_SP ("(Ada 83) asynchronous select not allowed!");
1793 Set_Statements (Abortable_Part_Node, P_Sequence_Of_Statements (SS_Sreq));
1794 return Abortable_Part_Node;
1795 end P_Abortable_Part;
1797 --------------------------
1798 -- 9.8 Abort Statement --
1799 --------------------------
1801 -- ABORT_STATEMENT ::= abort task_NAME {, task_NAME};
1803 -- The caller has checked that the initial token is ABORT
1805 -- Error recovery: cannot raise Error_Resync
1807 function P_Abort_Statement return Node_Id is
1808 Abort_Node : Node_Id;
1811 Abort_Node := New_Node (N_Abort_Statement, Token_Ptr);
1813 Set_Names (Abort_Node, New_List);
1816 Append (P_Name, Names (Abort_Node));
1817 exit when Token /= Tok_Comma;
1823 end P_Abort_Statement;