1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 pragma Style_Checks
(All_Checks
);
29 -- Turn off subprogram body ordering check. Subprograms are in order
30 -- by RM section rather than alphabetical
35 -- Local subprograms, used only in this chapter
37 function P_Accept_Alternative
return Node_Id
;
38 function P_Delay_Alternative
return Node_Id
;
39 function P_Delay_Relative_Statement
return Node_Id
;
40 function P_Delay_Until_Statement
return Node_Id
;
41 function P_Entry_Barrier
return Node_Id
;
42 function P_Entry_Body_Formal_Part
return Node_Id
;
43 function P_Entry_Declaration
return Node_Id
;
44 function P_Entry_Index_Specification
return Node_Id
;
45 function P_Protected_Definition
return Node_Id
;
46 function P_Protected_Operation_Declaration_Opt
return Node_Id
;
47 function P_Protected_Operation_Items
return List_Id
;
48 function P_Task_Definition
return Node_Id
;
49 function P_Task_Items
return List_Id
;
51 -----------------------------
52 -- 9.1 Task (also 10.1.3) --
53 -----------------------------
55 -- TASK_TYPE_DECLARATION ::=
56 -- task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
57 -- [is TASK_DEFINITION];
59 -- SINGLE_TASK_DECLARATION ::=
60 -- task DEFINING_IDENTIFIER [is TASK_DEFINITION];
63 -- task body DEFINING_IDENTIFIER is
66 -- HANDLED_SEQUENCE_OF_STATEMENTS
67 -- end [task_IDENTIFIER]
70 -- task body DEFINING_IDENTIFIER is separate;
72 -- This routine scans out a task declaration, task body, or task stub
74 -- The caller has checked that the initial token is TASK and scanned
75 -- past it, so that Token is set to the token after TASK
77 -- Error recovery: cannot raise Error_Resync
79 function P_Task
return Node_Id
is
82 Task_Sloc
: Source_Ptr
;
86 Scope
.Table
(Scope
.Last
).Etyp
:= E_Name
;
87 Scope
.Table
(Scope
.Last
).Ecol
:= Start_Column
;
88 Scope
.Table
(Scope
.Last
).Sloc
:= Token_Ptr
;
89 Scope
.Table
(Scope
.Last
).Lreq
:= False;
90 Task_Sloc
:= Prev_Token_Ptr
;
92 if Token
= Tok_Body
then
94 Name_Node
:= P_Defining_Identifier
;
95 Scope
.Table
(Scope
.Last
).Labl
:= Name_Node
;
97 if Token
= Tok_Left_Paren
then
98 Error_Msg_SC
("discriminant part not allowed in task body");
99 Discard_Junk_List
(P_Known_Discriminant_Part_Opt
);
106 if Token
= Tok_Separate
then
107 Scan
; -- past SEPARATE
108 Task_Node
:= New_Node
(N_Task_Body_Stub
, Task_Sloc
);
109 Set_Defining_Identifier
(Task_Node
, Name_Node
);
111 Pop_Scope_Stack
; -- remove unused entry
116 Task_Node
:= New_Node
(N_Task_Body
, Task_Sloc
);
117 Set_Defining_Identifier
(Task_Node
, Name_Node
);
118 Parse_Decls_Begin_End
(Task_Node
);
123 -- Otherwise we must have a task declaration
126 if Token
= Tok_Type
then
128 Task_Node
:= New_Node
(N_Task_Type_Declaration
, Task_Sloc
);
129 Name_Node
:= P_Defining_Identifier
;
130 Set_Defining_Identifier
(Task_Node
, Name_Node
);
131 Scope
.Table
(Scope
.Last
).Labl
:= Name_Node
;
132 Set_Discriminant_Specifications
133 (Task_Node
, P_Known_Discriminant_Part_Opt
);
136 Task_Node
:= New_Node
(N_Single_Task_Declaration
, Task_Sloc
);
137 Name_Node
:= P_Defining_Identifier
;
138 Set_Defining_Identifier
(Task_Node
, Name_Node
);
139 Scope
.Table
(Scope
.Last
).Labl
:= Name_Node
;
141 if Token
= Tok_Left_Paren
then
142 Error_Msg_SC
("discriminant part not allowed for single task");
143 Discard_Junk_List
(P_Known_Discriminant_Part_Opt
);
148 -- Parse optional task definition. Note that P_Task_Definition scans
149 -- out the semicolon as well as the task definition itself.
151 if Token
= Tok_Semicolon
then
153 -- A little check, if the next token after semicolon is
154 -- Entry, then surely the semicolon should really be IS
156 Scan
; -- past semicolon
158 if Token
= Tok_Entry
then
159 Error_Msg_SP
(""";"" should be IS");
160 Set_Task_Definition
(Task_Node
, P_Task_Definition
);
162 Pop_Scope_Stack
; -- Remove unused entry
165 TF_Is
; -- must have IS if no semicolon
166 Set_Task_Definition
(Task_Node
, P_Task_Definition
);
173 --------------------------------
174 -- 9.1 Task Type Declaration --
175 --------------------------------
177 -- Parsed by P_Task (9.1)
179 ----------------------------------
180 -- 9.1 Single Task Declaration --
181 ----------------------------------
183 -- Parsed by P_Task (9.1)
185 --------------------------
186 -- 9.1 Task Definition --
187 --------------------------
189 -- TASK_DEFINITION ::=
193 -- end [task_IDENTIFIER];
195 -- The caller has already made the scope stack entry
197 -- Note: there is a small deviation from official syntax here in that we
198 -- regard the semicolon after end as part of the Task_Definition, and in
199 -- the official syntax, it's part of the enclosing declaration. The reason
200 -- for this deviation is that otherwise the end processing would have to
201 -- be special cased, which would be a nuisance!
203 -- Error recovery: cannot raise Error_Resync
205 function P_Task_Definition
return Node_Id
is
209 Def_Node
:= New_Node
(N_Task_Definition
, Token_Ptr
);
210 Set_Visible_Declarations
(Def_Node
, P_Task_Items
);
212 if Token
= Tok_Private
then
213 Scan
; -- past PRIVATE
214 Set_Private_Declarations
(Def_Node
, P_Task_Items
);
216 -- Deal gracefully with multiple PRIVATE parts
218 while Token
= Tok_Private
loop
219 Error_Msg_SC
("Only one private part allowed per task");
220 Scan
; -- past PRIVATE
221 Append_List
(P_Task_Items
, Private_Declarations
(Def_Node
));
225 End_Statements
(Def_Node
);
227 end P_Task_Definition
;
233 -- TASK_ITEM ::= ENTRY_DECLARATION | REPRESENTATION_CLAUSE
235 -- This subprogram scans a (possibly empty) list of task items and pragmas
237 -- Error recovery: cannot raise Error_Resync
239 -- Note: a pragma can also be returned in this position
241 function P_Task_Items
return List_Id
is
244 Decl_Sloc
: Source_Ptr
;
247 -- Get rid of active SIS entry from outer scope. This means we will
248 -- miss some nested cases, but it doesn't seem worth the effort. See
249 -- discussion in Par for further details
251 SIS_Entry_Active
:= False;
253 -- Loop to scan out task items
258 Decl_Sloc
:= Token_Ptr
;
260 if Token
= Tok_Pragma
then
261 Append
(P_Pragma
, Items
);
263 elsif Token
= Tok_Entry
then
264 Append
(P_Entry_Declaration
, Items
);
266 elsif Token
= Tok_For
then
267 -- Representation clause in task declaration. The only rep
268 -- clause which is legal in a protected is an address clause,
269 -- so that is what we try to scan out.
271 Item_Node
:= P_Representation_Clause
;
273 if Nkind
(Item_Node
) = N_At_Clause
then
274 Append
(Item_Node
, Items
);
276 elsif Nkind
(Item_Node
) = N_Attribute_Definition_Clause
277 and then Chars
(Item_Node
) = Name_Address
279 Append
(Item_Node
, Items
);
283 ("the only representation clause " &
284 "allowed here is an address clause!", Decl_Sloc
);
287 elsif Token
= Tok_Identifier
288 or else Token
in Token_Class_Declk
290 Error_Msg_SC
("Illegal declaration in task definition");
291 Resync_Past_Semicolon
;
305 -- Parsed by P_Task (9.1)
307 ----------------------------------
308 -- 9.4 Protected (also 10.1.3) --
309 ----------------------------------
311 -- PROTECTED_TYPE_DECLARATION ::=
312 -- protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
313 -- is PROTECTED_DEFINITION;
315 -- SINGLE_PROTECTED_DECLARATION ::=
316 -- protected DEFINING_IDENTIFIER is PROTECTED_DEFINITION;
318 -- PROTECTED_BODY ::=
319 -- protected body DEFINING_IDENTIFIER is
320 -- {PROTECTED_OPERATION_ITEM}
321 -- end [protected_IDENTIFIER];
323 -- PROTECTED_BODY_STUB ::=
324 -- protected body DEFINING_IDENTIFIER is separate;
326 -- This routine scans out a protected declaration, protected body
327 -- or a protected stub.
329 -- The caller has checked that the initial token is PROTECTED and
330 -- scanned past it, so Token is set to the following token.
332 -- Error recovery: cannot raise Error_Resync
334 function P_Protected
return Node_Id
is
336 Protected_Node
: Node_Id
;
337 Protected_Sloc
: Source_Ptr
;
341 Scope
.Table
(Scope
.Last
).Etyp
:= E_Name
;
342 Scope
.Table
(Scope
.Last
).Ecol
:= Start_Column
;
343 Scope
.Table
(Scope
.Last
).Lreq
:= False;
344 Protected_Sloc
:= Prev_Token_Ptr
;
346 if Token
= Tok_Body
then
348 Name_Node
:= P_Defining_Identifier
;
349 Scope
.Table
(Scope
.Last
).Labl
:= Name_Node
;
351 if Token
= Tok_Left_Paren
then
352 Error_Msg_SC
("discriminant part not allowed in protected body");
353 Discard_Junk_List
(P_Known_Discriminant_Part_Opt
);
360 if Token
= Tok_Separate
then
361 Scan
; -- past SEPARATE
362 Protected_Node
:= New_Node
(N_Protected_Body_Stub
, Protected_Sloc
);
363 Set_Defining_Identifier
(Protected_Node
, Name_Node
);
365 Pop_Scope_Stack
; -- remove unused entry
370 Protected_Node
:= New_Node
(N_Protected_Body
, Protected_Sloc
);
371 Set_Defining_Identifier
(Protected_Node
, Name_Node
);
372 Set_Declarations
(Protected_Node
, P_Protected_Operation_Items
);
373 End_Statements
(Protected_Node
);
376 return Protected_Node
;
378 -- Otherwise we must have a protected declaration
381 if Token
= Tok_Type
then
384 New_Node
(N_Protected_Type_Declaration
, Protected_Sloc
);
385 Name_Node
:= P_Defining_Identifier
;
386 Set_Defining_Identifier
(Protected_Node
, Name_Node
);
387 Scope
.Table
(Scope
.Last
).Labl
:= Name_Node
;
388 Set_Discriminant_Specifications
389 (Protected_Node
, P_Known_Discriminant_Part_Opt
);
393 New_Node
(N_Single_Protected_Declaration
, Protected_Sloc
);
394 Name_Node
:= P_Defining_Identifier
;
395 Set_Defining_Identifier
(Protected_Node
, Name_Node
);
397 if Token
= Tok_Left_Paren
then
399 ("discriminant part not allowed for single protected");
400 Discard_Junk_List
(P_Known_Discriminant_Part_Opt
);
403 Scope
.Table
(Scope
.Last
).Labl
:= Name_Node
;
407 Set_Protected_Definition
(Protected_Node
, P_Protected_Definition
);
408 return Protected_Node
;
412 -------------------------------------
413 -- 9.4 Protected Type Declaration --
414 -------------------------------------
416 -- Parsed by P_Protected (9.4)
418 ---------------------------------------
419 -- 9.4 Single Protected Declaration --
420 ---------------------------------------
422 -- Parsed by P_Protected (9.4)
424 -------------------------------
425 -- 9.4 Protected Definition --
426 -------------------------------
428 -- PROTECTED_DEFINITION ::=
429 -- {PROTECTED_OPERATION_DECLARATION}
431 -- {PROTECTED_ELEMENT_DECLARATION}]
432 -- end [protected_IDENTIFIER]
434 -- PROTECTED_ELEMENT_DECLARATION ::=
435 -- PROTECTED_OPERATION_DECLARATION
436 -- | COMPONENT_DECLARATION
438 -- The caller has already established the scope stack entry
440 -- Error recovery: cannot raise Error_Resync
442 function P_Protected_Definition
return Node_Id
is
447 Def_Node
:= New_Node
(N_Protected_Definition
, Token_Ptr
);
449 -- Get rid of active SIS entry from outer scope. This means we will
450 -- miss some nested cases, but it doesn't seem worth the effort. See
451 -- discussion in Par for further details
453 SIS_Entry_Active
:= False;
455 -- Loop to scan visible declarations (protected operation declarations)
457 Set_Visible_Declarations
(Def_Node
, New_List
);
460 Item_Node
:= P_Protected_Operation_Declaration_Opt
;
461 exit when No
(Item_Node
);
462 Append
(Item_Node
, Visible_Declarations
(Def_Node
));
465 -- Deal with PRIVATE part (including graceful handling
466 -- of multiple PRIVATE parts).
468 Private_Loop
: while Token
= Tok_Private
loop
469 if No
(Private_Declarations
(Def_Node
)) then
470 Set_Private_Declarations
(Def_Node
, New_List
);
472 Error_Msg_SC
("duplicate private part");
475 Scan
; -- past PRIVATE
477 Declaration_Loop
: loop
478 if Token
= Tok_Identifier
then
479 P_Component_Items
(Private_Declarations
(Def_Node
));
481 Item_Node
:= P_Protected_Operation_Declaration_Opt
;
482 exit Declaration_Loop
when No
(Item_Node
);
483 Append
(Item_Node
, Private_Declarations
(Def_Node
));
485 end loop Declaration_Loop
;
486 end loop Private_Loop
;
488 End_Statements
(Def_Node
);
490 end P_Protected_Definition
;
492 ------------------------------------------
493 -- 9.4 Protected Operation Declaration --
494 ------------------------------------------
496 -- PROTECTED_OPERATION_DECLARATION ::=
497 -- SUBPROGRAM_DECLARATION
498 -- | ENTRY_DECLARATION
499 -- | REPRESENTATION_CLAUSE
501 -- Error recovery: cannot raise Error_Resync
503 -- Note: a pragma can also be returned in this position
505 -- We are not currently permitting representation clauses to appear as
506 -- protected operation declarations, do we have to rethink this???
508 function P_Protected_Operation_Declaration_Opt
return Node_Id
is
513 -- This loop runs more than once only when a junk declaration
517 if Token
= Tok_Pragma
then
520 elsif Token
= Tok_Entry
then
521 return P_Entry_Declaration
;
523 elsif Token
= Tok_Function
or else Token
= Tok_Procedure
then
524 return P_Subprogram
(Pf_Decl
);
526 elsif Token
= Tok_Identifier
then
529 Skip_Declaration
(L
);
531 if Nkind
(First
(L
)) = N_Object_Declaration
then
533 ("component must be declared in private part of " &
534 "protected type", P
);
537 ("illegal declaration in protected definition", P
);
540 elsif Token
in Token_Class_Declk
then
541 Error_Msg_SC
("illegal declaration in protected definition");
542 Resync_Past_Semicolon
;
544 -- Return now to avoid cascaded messages if next declaration
545 -- is a valid component declaration.
549 elsif Token
= Tok_For
then
551 ("representation clause not allowed in protected definition");
552 Resync_Past_Semicolon
;
558 end P_Protected_Operation_Declaration_Opt
;
560 -----------------------------------
561 -- 9.4 Protected Operation Item --
562 -----------------------------------
564 -- PROTECTED_OPERATION_ITEM ::=
565 -- SUBPROGRAM_DECLARATION
568 -- | REPRESENTATION_CLAUSE
570 -- This procedure parses and returns a list of protected operation items
572 -- We are not currently permitting representation clauses to appear
573 -- as protected operation items, do we have to rethink this???
575 function P_Protected_Operation_Items
return List_Id
is
579 Item_List
:= New_List
;
582 if Token
= Tok_Entry
or else Bad_Spelling_Of
(Tok_Entry
) then
583 Append
(P_Entry_Body
, Item_List
);
585 elsif Token
= Tok_Function
or else Bad_Spelling_Of
(Tok_Function
)
587 Token
= Tok_Procedure
or else Bad_Spelling_Of
(Tok_Procedure
)
589 Append
(P_Subprogram
(Pf_Decl_Pbod
), Item_List
);
591 elsif Token
= Tok_Pragma
or else Bad_Spelling_Of
(Tok_Pragma
) then
592 P_Pragmas_Opt
(Item_List
);
594 elsif Token
= Tok_Private
or else Bad_Spelling_Of
(Tok_Private
) then
595 Error_Msg_SC
("PRIVATE not allowed in protected body");
596 Scan
; -- past PRIVATE
598 elsif Token
= Tok_Identifier
then
600 ("all components must be declared in spec!");
601 Resync_Past_Semicolon
;
603 elsif Token
in Token_Class_Declk
then
604 Error_Msg_SC
("this declaration not allowed in protected body");
605 Resync_Past_Semicolon
;
613 end P_Protected_Operation_Items
;
615 ------------------------------
616 -- 9.5.2 Entry Declaration --
617 ------------------------------
619 -- ENTRY_DECLARATION ::=
620 -- entry DEFINING_IDENTIFIER [(DISCRETE_SUBTYPE_DEFINITION)]
621 -- PARAMETER_PROFILE;
623 -- The caller has checked that the initial token is ENTRY
625 -- Error recovery: cannot raise Error_Resync
627 function P_Entry_Declaration
return Node_Id
is
629 Scan_State
: Saved_Scan_State
;
632 Decl_Node
:= New_Node
(N_Entry_Declaration
, Token_Ptr
);
635 Set_Defining_Identifier
(Decl_Node
, P_Defining_Identifier
);
637 -- If left paren, could be (Discrete_Subtype_Definition) or Formal_Part
639 if Token
= Tok_Left_Paren
then
642 -- If identifier after left paren, could still be either
644 if Token
= Tok_Identifier
then
645 Save_Scan_State
(Scan_State
); -- at Id
648 -- If comma or colon after Id, must be Formal_Part
650 if Token
= Tok_Comma
or else Token
= Tok_Colon
then
651 Restore_Scan_State
(Scan_State
); -- to Id
652 Set_Parameter_Specifications
(Decl_Node
, P_Formal_Part
);
654 -- Else if Id wi no comma or colon, must be discrete subtype defn
657 Restore_Scan_State
(Scan_State
); -- to Id
658 Set_Discrete_Subtype_Definition
659 (Decl_Node
, P_Discrete_Subtype_Definition
);
661 Set_Parameter_Specifications
(Decl_Node
, P_Parameter_Profile
);
664 -- If no Id, must be discrete subtype definition
667 Set_Discrete_Subtype_Definition
668 (Decl_Node
, P_Discrete_Subtype_Definition
);
670 Set_Parameter_Specifications
(Decl_Node
, P_Parameter_Profile
);
674 -- Error recovery check for illegal return
676 if Token
= Tok_Return
then
677 Error_Msg_SC
("entry cannot have return value!");
679 Discard_Junk_Node
(P_Subtype_Indication
);
682 -- Error recovery check for improper use of entry barrier in spec
684 if Token
= Tok_When
then
685 Error_Msg_SC
("barrier not allowed here (belongs in body)");
687 Discard_Junk_Node
(P_Expression_No_Right_Paren
);
692 end P_Entry_Declaration
;
694 -----------------------------
695 -- 9.5.2 Accept Statement --
696 -----------------------------
698 -- ACCEPT_STATEMENT ::=
699 -- accept entry_DIRECT_NAME
700 -- [(ENTRY_INDEX)] PARAMETER_PROFILE [do
701 -- HANDLED_SEQUENCE_OF_STATEMENTS
702 -- end [entry_IDENTIFIER]];
704 -- The caller has checked that the initial token is ACCEPT
706 -- Error recovery: cannot raise Error_Resync. If an error occurs, the
707 -- scan is resynchronized past the next semicolon and control returns.
709 function P_Accept_Statement
return Node_Id
is
710 Scan_State
: Saved_Scan_State
;
711 Accept_Node
: Node_Id
;
716 Scope
.Table
(Scope
.Last
).Sloc
:= Token_Ptr
;
717 Scope
.Table
(Scope
.Last
).Ecol
:= Start_Column
;
719 Accept_Node
:= New_Node
(N_Accept_Statement
, Token_Ptr
);
721 Scope
.Table
(Scope
.Last
).Labl
:= Token_Node
;
723 Set_Entry_Direct_Name
(Accept_Node
, P_Identifier
);
725 -- Left paren could be (Entry_Index) or Formal_Part, determine which
727 if Token
= Tok_Left_Paren
then
728 Save_Scan_State
(Scan_State
); -- at left paren
729 Scan
; -- past left paren
731 -- If first token after left paren not identifier, then Entry_Index
733 if Token
/= Tok_Identifier
then
734 Set_Entry_Index
(Accept_Node
, P_Expression
);
736 Set_Parameter_Specifications
(Accept_Node
, P_Parameter_Profile
);
738 -- First token after left paren is identifier, could be either case
740 else -- Token = Tok_Identifier
741 Scan
; -- past identifier
743 -- If identifier followed by comma or colon, must be Formal_Part
745 if Token
= Tok_Comma
or else Token
= Tok_Colon
then
746 Restore_Scan_State
(Scan_State
); -- to left paren
747 Set_Parameter_Specifications
(Accept_Node
, P_Parameter_Profile
);
749 -- If identifier not followed by comma/colon, must be entry index
752 Restore_Scan_State
(Scan_State
); -- to left paren
753 Scan
; -- past left paren (again!)
754 Set_Entry_Index
(Accept_Node
, P_Expression
);
756 Set_Parameter_Specifications
(Accept_Node
, P_Parameter_Profile
);
761 -- Scan out DO if present
763 if Token
= Tok_Do
then
764 Scope
.Table
(Scope
.Last
).Etyp
:= E_Name
;
765 Scope
.Table
(Scope
.Last
).Lreq
:= False;
767 Hand_Seq
:= P_Handled_Sequence_Of_Statements
;
768 Set_Handled_Statement_Sequence
(Accept_Node
, Hand_Seq
);
769 End_Statements
(Handled_Statement_Sequence
(Accept_Node
));
771 -- Exception handlers not allowed in Ada 95 node
773 if Present
(Exception_Handlers
(Hand_Seq
)) then
776 ("(Ada 83) exception handlers in accept not allowed",
777 First_Non_Pragma
(Exception_Handlers
(Hand_Seq
)));
782 Pop_Scope_Stack
; -- discard unused entry
788 -- If error, resynchronize past semicolon
792 Resync_Past_Semicolon
;
795 end P_Accept_Statement
;
797 ------------------------
798 -- 9.5.2 Entry Index --
799 ------------------------
801 -- Parsed by P_Expression (4.4)
803 -----------------------
804 -- 9.5.2 Entry Body --
805 -----------------------
808 -- entry DEFINING_IDENTIFIER ENTRY_BODY_FORMAL_PART ENTRY_BARRIER is
811 -- HANDLED_SEQUENCE_OF_STATEMENTS
812 -- end [entry_IDENTIFIER];
814 -- The caller has checked that the initial token is ENTRY
816 -- Error_Recovery: cannot raise Error_Resync
818 function P_Entry_Body
return Node_Id
is
819 Entry_Node
: Node_Id
;
820 Formal_Part_Node
: Node_Id
;
825 Entry_Node
:= New_Node
(N_Entry_Body
, Token_Ptr
);
828 Scope
.Table
(Scope
.Last
).Ecol
:= Start_Column
;
829 Scope
.Table
(Scope
.Last
).Lreq
:= False;
830 Scope
.Table
(Scope
.Last
).Etyp
:= E_Name
;
832 Name_Node
:= P_Defining_Identifier
;
833 Set_Defining_Identifier
(Entry_Node
, Name_Node
);
834 Scope
.Table
(Scope
.Last
).Labl
:= Name_Node
;
836 Formal_Part_Node
:= P_Entry_Body_Formal_Part
;
837 Set_Entry_Body_Formal_Part
(Entry_Node
, Formal_Part_Node
);
839 Set_Condition
(Formal_Part_Node
, P_Entry_Barrier
);
840 Parse_Decls_Begin_End
(Entry_Node
);
844 -----------------------------------
845 -- 9.5.2 Entry Body Formal Part --
846 -----------------------------------
848 -- ENTRY_BODY_FORMAL_PART ::=
849 -- [(ENTRY_INDEX_SPECIFICATION)] [PARAMETER_PART]
851 -- Error_Recovery: cannot raise Error_Resync
853 function P_Entry_Body_Formal_Part
return Node_Id
is
854 Fpart_Node
: Node_Id
;
855 Scan_State
: Saved_Scan_State
;
858 Fpart_Node
:= New_Node
(N_Entry_Body_Formal_Part
, Token_Ptr
);
860 -- See if entry index specification present, and if so parse it
862 if Token
= Tok_Left_Paren
then
863 Save_Scan_State
(Scan_State
); -- at left paren
864 Scan
; -- past left paren
866 if Token
= Tok_For
then
867 Set_Entry_Index_Specification
868 (Fpart_Node
, P_Entry_Index_Specification
);
871 Restore_Scan_State
(Scan_State
); -- to left paren
874 -- Check for (common?) case of left paren omitted before FOR. This
875 -- is a tricky case, because the corresponding missing left paren
876 -- can cause real havoc if a formal part is present which gets
877 -- treated as part of the discrete subtype definition of the
878 -- entry index specification, so just give error and resynchronize
880 elsif Token
= Tok_For
then
881 T_Left_Paren
; -- to give error message
885 Set_Parameter_Specifications
(Fpart_Node
, P_Parameter_Profile
);
887 end P_Entry_Body_Formal_Part
;
889 --------------------------
890 -- 9.5.2 Entry Barrier --
891 --------------------------
893 -- ENTRY_BARRIER ::= when CONDITION
895 -- Error_Recovery: cannot raise Error_Resync
897 function P_Entry_Barrier
return Node_Id
is
901 if Token
= Tok_When
then
903 Bnode
:= P_Expression_No_Right_Paren
;
905 if Token
= Tok_Colon_Equal
then
906 Error_Msg_SC
(""":="" should be ""=""");
908 Bnode
:= P_Expression_No_Right_Paren
;
912 T_When
; -- to give error message
920 --------------------------------------
921 -- 9.5.2 Entry Index Specification --
922 --------------------------------------
924 -- ENTRY_INDEX_SPECIFICATION ::=
925 -- for DEFINING_IDENTIFIER in DISCRETE_SUBTYPE_DEFINITION
927 -- Error recovery: can raise Error_Resync
929 function P_Entry_Index_Specification
return Node_Id
is
930 Iterator_Node
: Node_Id
;
933 Iterator_Node
:= New_Node
(N_Entry_Index_Specification
, Token_Ptr
);
935 Set_Defining_Identifier
(Iterator_Node
, P_Defining_Identifier
);
937 Set_Discrete_Subtype_Definition
938 (Iterator_Node
, P_Discrete_Subtype_Definition
);
939 return Iterator_Node
;
940 end P_Entry_Index_Specification
;
942 ---------------------------------
943 -- 9.5.3 Entry Call Statement --
944 ---------------------------------
946 -- Parsed by P_Name (4.1). Within a select, an entry call is parsed
947 -- by P_Select_Statement (9.7)
949 ------------------------------
950 -- 9.5.4 Requeue Statement --
951 ------------------------------
953 -- REQUEUE_STATEMENT ::= requeue entry_NAME [with abort];
955 -- The caller has checked that the initial token is requeue
957 -- Error recovery: can raise Error_Resync
959 function P_Requeue_Statement
return Node_Id
is
960 Requeue_Node
: Node_Id
;
963 Requeue_Node
:= New_Node
(N_Requeue_Statement
, Token_Ptr
);
964 Scan
; -- past REQUEUE
965 Set_Name
(Requeue_Node
, P_Name
);
967 if Token
= Tok_With
then
970 Set_Abort_Present
(Requeue_Node
, True);
975 end P_Requeue_Statement
;
977 --------------------------
978 -- 9.6 Delay Statement --
979 --------------------------
981 -- DELAY_STATEMENT ::=
982 -- DELAY_UNTIL_STATEMENT
983 -- | DELAY_RELATIVE_STATEMENT
985 -- The caller has checked that the initial token is DELAY
987 -- Error recovery: cannot raise Error_Resync
989 function P_Delay_Statement
return Node_Id
is
993 -- The following check for delay until misused in Ada 83 doesn't catch
994 -- all cases, but it's good enough to catch most of them!
996 if Token_Name
= Name_Until
then
997 Check_95_Keyword
(Tok_Until
, Tok_Left_Paren
);
998 Check_95_Keyword
(Tok_Until
, Tok_Identifier
);
1001 if Token
= Tok_Until
then
1002 return P_Delay_Until_Statement
;
1004 return P_Delay_Relative_Statement
;
1006 end P_Delay_Statement
;
1008 --------------------------------
1009 -- 9.6 Delay Until Statement --
1010 --------------------------------
1012 -- DELAY_UNTIL_STATEMENT ::= delay until delay_EXPRESSION;
1014 -- The caller has checked that the initial token is DELAY, scanned it
1015 -- out and checked that the current token is UNTIL
1017 -- Error recovery: cannot raise Error_Resync
1019 function P_Delay_Until_Statement
return Node_Id
is
1020 Delay_Node
: Node_Id
;
1023 Delay_Node
:= New_Node
(N_Delay_Until_Statement
, Prev_Token_Ptr
);
1025 Set_Expression
(Delay_Node
, P_Expression_No_Right_Paren
);
1028 end P_Delay_Until_Statement
;
1030 -----------------------------------
1031 -- 9.6 Delay Relative Statement --
1032 -----------------------------------
1034 -- DELAY_RELATIVE_STATEMENT ::= delay delay_EXPRESSION;
1036 -- The caller has checked that the initial token is DELAY, scanned it
1037 -- out and determined that the current token is not UNTIL
1039 -- Error recovery: cannot raise Error_Resync
1041 function P_Delay_Relative_Statement
return Node_Id
is
1042 Delay_Node
: Node_Id
;
1045 Delay_Node
:= New_Node
(N_Delay_Relative_Statement
, Prev_Token_Ptr
);
1046 Set_Expression
(Delay_Node
, P_Expression_No_Right_Paren
);
1047 Check_Simple_Expression_In_Ada_83
(Expression
(Delay_Node
));
1050 end P_Delay_Relative_Statement
;
1052 ---------------------------
1053 -- 9.7 Select Statement --
1054 ---------------------------
1056 -- SELECT_STATEMENT ::=
1058 -- | TIMED_ENTRY_CALL
1059 -- | CONDITIONAL_ENTRY_CALL
1060 -- | ASYNCHRONOUS_SELECT
1062 -- SELECTIVE_ACCEPT ::=
1065 -- SELECT_ALTERNATIVE
1068 -- SELECT_ALTERNATIVE
1070 -- SEQUENCE_OF_STATEMENTS]
1073 -- GUARD ::= when CONDITION =>
1075 -- Note: the guard preceding a select alternative is included as part
1076 -- of the node generated for a selective accept alternative.
1078 -- SELECT_ALTERNATIVE ::=
1079 -- ACCEPT_ALTERNATIVE
1080 -- | DELAY_ALTERNATIVE
1081 -- | TERMINATE_ALTERNATIVE
1083 -- TIMED_ENTRY_CALL ::=
1085 -- ENTRY_CALL_ALTERNATIVE
1087 -- DELAY_ALTERNATIVE
1090 -- CONDITIONAL_ENTRY_CALL ::=
1092 -- ENTRY_CALL_ALTERNATIVE
1094 -- SEQUENCE_OF_STATEMENTS
1097 -- ENTRY_CALL_ALTERNATIVE ::=
1098 -- ENTRY_CALL_STATEMENT [SEQUENCE_OF_STATEMENTS]
1100 -- ASYNCHRONOUS_SELECT ::=
1102 -- TRIGGERING_ALTERNATIVE
1107 -- TRIGGERING_ALTERNATIVE ::=
1108 -- TRIGGERING_STATEMENT [SEQUENCE_OF_STATEMENTS]
1110 -- TRIGGERING_STATEMENT ::= ENTRY_CALL_STATEMENT | DELAY_STATEMENT
1112 -- The caller has checked that the initial token is SELECT
1114 -- Error recovery: can raise Error_Resync
1116 function P_Select_Statement
return Node_Id
is
1117 Select_Node
: Node_Id
;
1118 Select_Sloc
: Source_Ptr
;
1119 Stmnt_Sloc
: Source_Ptr
;
1120 Ecall_Node
: Node_Id
;
1121 Alternative
: Node_Id
;
1122 Select_Pragmas
: List_Id
;
1123 Alt_Pragmas
: List_Id
;
1124 Statement_List
: List_Id
;
1126 Cond_Expr
: Node_Id
;
1127 Delay_Stmnt
: Node_Id
;
1131 Scope
.Table
(Scope
.Last
).Etyp
:= E_Select
;
1132 Scope
.Table
(Scope
.Last
).Ecol
:= Start_Column
;
1133 Scope
.Table
(Scope
.Last
).Sloc
:= Token_Ptr
;
1134 Scope
.Table
(Scope
.Last
).Labl
:= Error
;
1136 Select_Sloc
:= Token_Ptr
;
1137 Scan
; -- past SELECT
1138 Stmnt_Sloc
:= Token_Ptr
;
1139 Select_Pragmas
:= P_Pragmas_Opt
;
1141 -- If first token after select is designator, then we have an entry
1142 -- call, which must be the start of a conditional entry call, timed
1143 -- entry call or asynchronous select
1145 if Token
in Token_Class_Desig
then
1147 -- Scan entry call statement
1150 Ecall_Node
:= P_Name
;
1152 -- ?? The following two clauses exactly parallel code in ch5
1153 -- and should be commoned sometime
1155 if Nkind
(Ecall_Node
) = N_Indexed_Component
then
1157 Prefix_Node
: Node_Id
:= Prefix
(Ecall_Node
);
1158 Exprs_Node
: List_Id
:= Expressions
(Ecall_Node
);
1160 Change_Node
(Ecall_Node
, N_Procedure_Call_Statement
);
1161 Set_Name
(Ecall_Node
, Prefix_Node
);
1162 Set_Parameter_Associations
(Ecall_Node
, Exprs_Node
);
1165 elsif Nkind
(Ecall_Node
) = N_Function_Call
then
1167 Fname_Node
: Node_Id
:= Name
(Ecall_Node
);
1168 Params_List
: List_Id
:= Parameter_Associations
(Ecall_Node
);
1171 Change_Node
(Ecall_Node
, N_Procedure_Call_Statement
);
1172 Set_Name
(Ecall_Node
, Fname_Node
);
1173 Set_Parameter_Associations
(Ecall_Node
, Params_List
);
1176 elsif Nkind
(Ecall_Node
) = N_Identifier
1177 or else Nkind
(Ecall_Node
) = N_Selected_Component
1179 -- Case of a call to a parameterless entry.
1182 C_Node
: constant Node_Id
:=
1183 New_Node
(N_Procedure_Call_Statement
, Stmnt_Sloc
);
1185 Set_Name
(C_Node
, Ecall_Node
);
1186 Set_Parameter_Associations
(C_Node
, No_List
);
1187 Ecall_Node
:= C_Node
;
1194 when Error_Resync
=>
1195 Resync_Past_Semicolon
;
1199 Statement_List
:= P_Sequence_Of_Statements
(SS_Eltm_Ortm_Tatm
);
1201 -- OR follows, we have a timed entry call
1203 if Token
= Tok_Or
then
1205 Alt_Pragmas
:= P_Pragmas_Opt
;
1207 Select_Node
:= New_Node
(N_Timed_Entry_Call
, Select_Sloc
);
1208 Set_Entry_Call_Alternative
(Select_Node
,
1209 Make_Entry_Call_Alternative
(Stmnt_Sloc
,
1210 Entry_Call_Statement
=> Ecall_Node
,
1211 Pragmas_Before
=> Select_Pragmas
,
1212 Statements
=> Statement_List
));
1214 -- Only possibility is delay alternative. If we have anything
1215 -- else, give message, and treat as conditional entry call.
1217 if Token
/= Tok_Delay
then
1219 ("only allowed alternative in timed entry call is delay!");
1220 Discard_Junk_List
(P_Sequence_Of_Statements
(SS_Sreq
));
1221 Set_Delay_Alternative
(Select_Node
, Error
);
1224 Set_Delay_Alternative
(Select_Node
, P_Delay_Alternative
);
1226 (Delay_Alternative
(Select_Node
), Alt_Pragmas
);
1229 -- ELSE follows, we have a conditional entry call
1231 elsif Token
= Tok_Else
then
1233 Select_Node
:= New_Node
(N_Conditional_Entry_Call
, Select_Sloc
);
1235 Set_Entry_Call_Alternative
(Select_Node
,
1236 Make_Entry_Call_Alternative
(Stmnt_Sloc
,
1237 Entry_Call_Statement
=> Ecall_Node
,
1238 Pragmas_Before
=> Select_Pragmas
,
1239 Statements
=> Statement_List
));
1242 (Select_Node
, P_Sequence_Of_Statements
(SS_Sreq
));
1244 -- Only remaining case is THEN ABORT (asynchronous select)
1246 elsif Token
= Tok_Abort
then
1248 Make_Asynchronous_Select
(Select_Sloc
,
1249 Triggering_Alternative
=>
1250 Make_Triggering_Alternative
(Stmnt_Sloc
,
1251 Triggering_Statement
=> Ecall_Node
,
1252 Pragmas_Before
=> Select_Pragmas
,
1253 Statements
=> Statement_List
),
1254 Abortable_Part
=> P_Abortable_Part
);
1260 Error_Msg_BC
("OR or ELSE expected");
1262 Error_Msg_BC
("OR or ELSE or THEN ABORT expected");
1265 Select_Node
:= Error
;
1270 -- Here we have a selective accept or an an asynchronous select (first
1271 -- token after SELECT is other than a designator token).
1274 -- If we have delay with no guard, could be asynchronous select
1276 if Token
= Tok_Delay
then
1277 Delay_Stmnt
:= P_Delay_Statement
;
1278 Statement_List
:= P_Sequence_Of_Statements
(SS_Eltm_Ortm_Tatm
);
1280 -- Asynchronous select
1282 if Token
= Tok_Abort
then
1284 Make_Asynchronous_Select
(Select_Sloc
,
1285 Triggering_Alternative
=>
1286 Make_Triggering_Alternative
(Stmnt_Sloc
,
1287 Triggering_Statement
=> Delay_Stmnt
,
1288 Pragmas_Before
=> Select_Pragmas
,
1289 Statements
=> Statement_List
),
1290 Abortable_Part
=> P_Abortable_Part
);
1295 -- Delay which was not an asynchronous select. Must be a selective
1296 -- accept, and since at least one accept statement is required,
1297 -- we must have at least one OR phrase present.
1300 Alt_List
:= New_List
(
1301 Make_Delay_Alternative
(Stmnt_Sloc
,
1302 Delay_Statement
=> Delay_Stmnt
,
1303 Pragmas_Before
=> Select_Pragmas
,
1304 Statements
=> Statement_List
));
1306 Alt_Pragmas
:= P_Pragmas_Opt
;
1309 -- If not a delay statement, then must be another possibility for
1310 -- a selective accept alternative, or perhaps a guard is present
1313 Alt_List
:= New_List
;
1314 Alt_Pragmas
:= Select_Pragmas
;
1317 Select_Node
:= New_Node
(N_Selective_Accept
, Select_Sloc
);
1318 Set_Select_Alternatives
(Select_Node
, Alt_List
);
1320 -- Scan out selective accept alternatives. On entry to this loop,
1321 -- we are just past a SELECT or OR token, and any pragmas that
1322 -- immediately follow the SELECT or OR are in Alt_Pragmas.
1325 if Token
= Tok_When
then
1327 if Present
(Alt_Pragmas
) then
1328 Error_Msg_SC
("pragmas may not precede guard");
1332 Cond_Expr
:= P_Expression_No_Right_Paren
;
1334 Alt_Pragmas
:= P_Pragmas_Opt
;
1340 if Token
= Tok_Accept
then
1341 Alternative
:= P_Accept_Alternative
;
1343 -- Check for junk attempt at asynchronous select using
1344 -- an Accept alternative as the triggering statement
1346 if Token
= Tok_Abort
1347 and then Is_Empty_List
(Alt_List
)
1348 and then No
(Cond_Expr
)
1351 ("triggering statement must be entry call or delay",
1352 Sloc
(Alternative
));
1353 Scan
; -- past junk ABORT
1354 Discard_Junk_List
(P_Sequence_Of_Statements
(SS_Sreq
));
1359 elsif Token
= Tok_Delay
then
1360 Alternative
:= P_Delay_Alternative
;
1362 elsif Token
= Tok_Terminate
then
1363 Alternative
:= P_Terminate_Alternative
;
1367 ("Select alternative (ACCEPT, ABORT, DELAY) expected");
1368 Alternative
:= Error
;
1370 if Token
= Tok_Semicolon
then
1371 Scan
; -- past junk semicolon
1375 -- THEN ABORT at this stage is just junk
1377 if Token
= Tok_Abort
then
1378 Error_Msg_SP
("misplaced `THEN ABORT`");
1379 Scan
; -- past junk ABORT
1380 Discard_Junk_List
(P_Sequence_Of_Statements
(SS_Sreq
));
1385 if Alternative
/= Error
then
1386 Set_Condition
(Alternative
, Cond_Expr
);
1387 Set_Pragmas_Before
(Alternative
, Alt_Pragmas
);
1388 Append
(Alternative
, Alt_List
);
1391 exit when Token
/= Tok_Or
;
1395 Alt_Pragmas
:= P_Pragmas_Opt
;
1398 if Token
= Tok_Else
then
1401 (Select_Node
, P_Sequence_Of_Statements
(SS_Ortm_Sreq
));
1403 if Token
= Tok_Or
then
1404 Error_Msg_SC
("select alternative cannot follow else part!");
1412 end P_Select_Statement
;
1414 -----------------------------
1415 -- 9.7.1 Selective Accept --
1416 -----------------------------
1418 -- Parsed by P_Select_Statement (9.7)
1424 -- Parsed by P_Select_Statement (9.7)
1426 -------------------------------
1427 -- 9.7.1 Select Alternative --
1428 -------------------------------
1430 -- SELECT_ALTERNATIVE ::=
1431 -- ACCEPT_ALTERNATIVE
1432 -- | DELAY_ALTERNATIVE
1433 -- | TERMINATE_ALTERNATIVE
1435 -- Note: the guard preceding a select alternative is included as part
1436 -- of the node generated for a selective accept alternative.
1438 -- Error recovery: cannot raise Error_Resync
1440 -------------------------------
1441 -- 9.7.1 Accept Alternative --
1442 -------------------------------
1444 -- ACCEPT_ALTERNATIVE ::=
1445 -- ACCEPT_STATEMENT [SEQUENCE_OF_STATEMENTS]
1447 -- Error_Recovery: Cannot raise Error_Resync
1449 -- Note: the caller is responsible for setting the Pragmas_Before
1450 -- field of the returned N_Terminate_Alternative node.
1452 function P_Accept_Alternative
return Node_Id
is
1453 Accept_Alt_Node
: Node_Id
;
1456 Accept_Alt_Node
:= New_Node
(N_Accept_Alternative
, Token_Ptr
);
1457 Set_Accept_Statement
(Accept_Alt_Node
, P_Accept_Statement
);
1459 -- Note: the reason that we accept THEN ABORT as a terminator for
1460 -- the sequence of statements is for error recovery which allows
1461 -- for misuse of an accept statement as a triggering statememt.
1464 (Accept_Alt_Node
, P_Sequence_Of_Statements
(SS_Eltm_Ortm_Tatm
));
1465 return Accept_Alt_Node
;
1466 end P_Accept_Alternative
;
1468 ------------------------------
1469 -- 9.7.1 Delay Alternative --
1470 ------------------------------
1472 -- DELAY_ALTERNATIVE ::=
1473 -- DELAY_STATEMENT [SEQUENCE_OF_STATEMENTS]
1475 -- Error_Recovery: Cannot raise Error_Resync
1477 -- Note: the caller is responsible for setting the Pragmas_Before
1478 -- field of the returned N_Terminate_Alternative node.
1480 function P_Delay_Alternative
return Node_Id
is
1481 Delay_Alt_Node
: Node_Id
;
1484 Delay_Alt_Node
:= New_Node
(N_Delay_Alternative
, Token_Ptr
);
1485 Set_Delay_Statement
(Delay_Alt_Node
, P_Delay_Statement
);
1487 -- Note: the reason that we accept THEN ABORT as a terminator for
1488 -- the sequence of statements is for error recovery which allows
1489 -- for misuse of an accept statement as a triggering statememt.
1492 (Delay_Alt_Node
, P_Sequence_Of_Statements
(SS_Eltm_Ortm_Tatm
));
1493 return Delay_Alt_Node
;
1494 end P_Delay_Alternative
;
1496 ----------------------------------
1497 -- 9.7.1 Terminate Alternative --
1498 ----------------------------------
1500 -- TERMINATE_ALTERNATIVE ::= terminate;
1502 -- Error_Recovery: Cannot raise Error_Resync
1504 -- Note: the caller is responsible for setting the Pragmas_Before
1505 -- field of the returned N_Terminate_Alternative node.
1507 function P_Terminate_Alternative
return Node_Id
is
1508 Terminate_Alt_Node
: Node_Id
;
1511 Terminate_Alt_Node
:= New_Node
(N_Terminate_Alternative
, Token_Ptr
);
1512 Scan
; -- past TERMINATE
1515 -- For all other select alternatives, the sequence of statements
1516 -- after the alternative statement will swallow up any pragmas
1517 -- coming in this position. But the terminate alternative has no
1518 -- sequence of statements, so the pragmas here must be treated
1521 Set_Pragmas_After
(Terminate_Alt_Node
, P_Pragmas_Opt
);
1522 return Terminate_Alt_Node
;
1523 end P_Terminate_Alternative
;
1525 -----------------------------
1526 -- 9.7.2 Timed Entry Call --
1527 -----------------------------
1529 -- Parsed by P_Select_Statement (9.7)
1531 -----------------------------------
1532 -- 9.7.2 Entry Call Alternative --
1533 -----------------------------------
1535 -- Parsed by P_Select_Statement (9.7)
1537 -----------------------------------
1538 -- 9.7.3 Conditional Entry Call --
1539 -----------------------------------
1541 -- Parsed by P_Select_Statement (9.7)
1543 --------------------------------
1544 -- 9.7.4 Asynchronous Select --
1545 --------------------------------
1547 -- Parsed by P_Select_Statement (9.7)
1549 -----------------------------------
1550 -- 9.7.4 Triggering Alternative --
1551 -----------------------------------
1553 -- Parsed by P_Select_Statement (9.7)
1555 ---------------------------------
1556 -- 9.7.4 Triggering Statement --
1557 ---------------------------------
1559 -- Parsed by P_Select_Statement (9.7)
1561 ---------------------------
1562 -- 9.7.4 Abortable Part --
1563 ---------------------------
1565 -- ABORTABLE_PART ::= SEQUENCE_OF_STATEMENTS
1567 -- The caller has verified that THEN ABORT is present, and Token is
1568 -- pointing to the ABORT on entry (or if not, then we have an error)
1570 -- Error recovery: cannot raise Error_Resync
1572 function P_Abortable_Part
return Node_Id
is
1573 Abortable_Part_Node
: Node_Id
;
1576 Abortable_Part_Node
:= New_Node
(N_Abortable_Part
, Token_Ptr
);
1577 T_Abort
; -- scan past ABORT
1580 Error_Msg_SP
("(Ada 83) asynchronous select not allowed!");
1583 Set_Statements
(Abortable_Part_Node
, P_Sequence_Of_Statements
(SS_Sreq
));
1584 return Abortable_Part_Node
;
1585 end P_Abortable_Part
;
1587 --------------------------
1588 -- 9.8 Abort Statement --
1589 --------------------------
1591 -- ABORT_STATEMENT ::= abort task_NAME {, task_NAME};
1593 -- The caller has checked that the initial token is ABORT
1595 -- Error recovery: cannot raise Error_Resync
1597 function P_Abort_Statement
return Node_Id
is
1598 Abort_Node
: Node_Id
;
1601 Abort_Node
:= New_Node
(N_Abort_Statement
, Token_Ptr
);
1603 Set_Names
(Abort_Node
, New_List
);
1606 Append
(P_Name
, Names
(Abort_Node
));
1607 exit when Token
/= Tok_Comma
;
1613 end P_Abort_Statement
;