]>
Commit | Line | Data |
---|---|---|
49d882a7 | 1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P A R . C H 9 -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
71e45bc2 | 9 | -- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- |
49d882a7 | 10 | -- -- |
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- -- | |
80df182a | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
49d882a7 | 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 -- | |
80df182a | 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. -- | |
49d882a7 | 20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
e78e8c8e | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
49d882a7 | 23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
26 | pragma Style_Checks (All_Checks); | |
3817baeb | 27 | -- Turn off subprogram body ordering check. Subprograms are in order by RM |
28 | -- section rather than alphabetical. | |
49d882a7 | 29 | |
30 | separate (Par) | |
31 | package body Ch9 is | |
32 | ||
33 | -- Local subprograms, used only in this chapter | |
34 | ||
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; | |
ddf1337b | 43 | function P_Protected_Definition return Node_Id; |
49d882a7 | 44 | function P_Protected_Operation_Declaration_Opt return Node_Id; |
45 | function P_Protected_Operation_Items return List_Id; | |
49d882a7 | 46 | function P_Task_Items return List_Id; |
ddf1337b | 47 | function P_Task_Definition return Node_Id; |
30e864df | 48 | |
49d882a7 | 49 | ----------------------------- |
50 | -- 9.1 Task (also 10.1.3) -- | |
51 | ----------------------------- | |
52 | ||
53 | -- TASK_TYPE_DECLARATION ::= | |
54 | -- task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART] | |
ddf1337b | 55 | -- [ASPECT_SPECIFICATIONS] |
56 | -- [is [new INTERFACE_LIST with] TASK_DEFINITION]; | |
49d882a7 | 57 | |
58 | -- SINGLE_TASK_DECLARATION ::= | |
8e8a39bd | 59 | -- task DEFINING_IDENTIFIER |
ddf1337b | 60 | -- [ASPECT_SPECIFICATIONS] |
61 | -- [is [new INTERFACE_LIST with] TASK_DEFINITION]; | |
49d882a7 | 62 | |
63 | -- TASK_BODY ::= | |
64 | -- task body DEFINING_IDENTIFIER is | |
65 | -- DECLARATIVE_PART | |
66 | -- begin | |
67 | -- HANDLED_SEQUENCE_OF_STATEMENTS | |
68 | -- end [task_IDENTIFIER] | |
69 | ||
70 | -- TASK_BODY_STUB ::= | |
71 | -- task body DEFINING_IDENTIFIER is separate; | |
72 | ||
73 | -- This routine scans out a task declaration, task body, or task stub | |
74 | ||
75 | -- The caller has checked that the initial token is TASK and scanned | |
76 | -- past it, so that Token is set to the token after TASK | |
77 | ||
78 | -- Error recovery: cannot raise Error_Resync | |
79 | ||
80 | function P_Task return Node_Id is | |
81 | Name_Node : Node_Id; | |
82 | Task_Node : Node_Id; | |
83 | Task_Sloc : Source_Ptr; | |
84 | ||
85 | begin | |
86 | Push_Scope_Stack; | |
87 | Scope.Table (Scope.Last).Etyp := E_Name; | |
88 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
89 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
90 | Scope.Table (Scope.Last).Lreq := False; | |
91 | Task_Sloc := Prev_Token_Ptr; | |
92 | ||
93 | if Token = Tok_Body then | |
94 | Scan; -- past BODY | |
ec621b58 | 95 | Name_Node := P_Defining_Identifier (C_Is); |
49d882a7 | 96 | Scope.Table (Scope.Last).Labl := Name_Node; |
97 | ||
98 | if Token = Tok_Left_Paren then | |
99 | Error_Msg_SC ("discriminant part not allowed in task body"); | |
100 | Discard_Junk_List (P_Known_Discriminant_Part_Opt); | |
101 | end if; | |
102 | ||
103 | TF_Is; | |
104 | ||
105 | -- Task stub | |
106 | ||
107 | if Token = Tok_Separate then | |
108 | Scan; -- past SEPARATE | |
109 | Task_Node := New_Node (N_Task_Body_Stub, Task_Sloc); | |
110 | Set_Defining_Identifier (Task_Node, Name_Node); | |
111 | TF_Semicolon; | |
112 | Pop_Scope_Stack; -- remove unused entry | |
113 | ||
114 | -- Task body | |
115 | ||
116 | else | |
117 | Task_Node := New_Node (N_Task_Body, Task_Sloc); | |
118 | Set_Defining_Identifier (Task_Node, Name_Node); | |
119 | Parse_Decls_Begin_End (Task_Node); | |
120 | end if; | |
121 | ||
122 | return Task_Node; | |
123 | ||
124 | -- Otherwise we must have a task declaration | |
125 | ||
126 | else | |
127 | if Token = Tok_Type then | |
128 | Scan; -- past TYPE | |
129 | Task_Node := New_Node (N_Task_Type_Declaration, Task_Sloc); | |
130 | Name_Node := P_Defining_Identifier; | |
131 | Set_Defining_Identifier (Task_Node, Name_Node); | |
132 | Scope.Table (Scope.Last).Labl := Name_Node; | |
133 | Set_Discriminant_Specifications | |
134 | (Task_Node, P_Known_Discriminant_Part_Opt); | |
135 | ||
136 | else | |
137 | Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc); | |
ec621b58 | 138 | Name_Node := P_Defining_Identifier (C_Is); |
49d882a7 | 139 | Set_Defining_Identifier (Task_Node, Name_Node); |
140 | Scope.Table (Scope.Last).Labl := Name_Node; | |
141 | ||
142 | if Token = Tok_Left_Paren then | |
143 | Error_Msg_SC ("discriminant part not allowed for single task"); | |
144 | Discard_Junk_List (P_Known_Discriminant_Part_Opt); | |
145 | end if; | |
49d882a7 | 146 | end if; |
147 | ||
ddf1337b | 148 | -- Scan aspect specifications, don't eat the semicolon, since it |
149 | -- might not be there if we have an IS. | |
30e864df | 150 | |
ddf1337b | 151 | P_Aspect_Specifications (Task_Node, Semicolon => False); |
30e864df | 152 | |
49d882a7 | 153 | -- Parse optional task definition. Note that P_Task_Definition scans |
30e864df | 154 | -- out the semicolon and possible aspect specifications as well as |
155 | -- the task definition itself. | |
49d882a7 | 156 | |
ddf1337b | 157 | if Token = Tok_Semicolon then |
49d882a7 | 158 | |
ddf1337b | 159 | -- A little check, if the next token after semicolon is Entry, |
160 | -- then surely the semicolon should really be IS | |
49d882a7 | 161 | |
162 | Scan; -- past semicolon | |
163 | ||
164 | if Token = Tok_Entry then | |
503f7fd3 | 165 | Error_Msg_SP -- CODEFIX |
166 | ("|"";"" should be IS"); | |
ddf1337b | 167 | Set_Task_Definition (Task_Node, P_Task_Definition); |
49d882a7 | 168 | else |
169 | Pop_Scope_Stack; -- Remove unused entry | |
170 | end if; | |
30e864df | 171 | |
172 | -- Here we have a task definition | |
173 | ||
49d882a7 | 174 | else |
175 | TF_Is; -- must have IS if no semicolon | |
4660e715 | 176 | |
177 | -- Ada 2005 (AI-345) | |
178 | ||
179 | if Token = Tok_New then | |
180 | Scan; -- past NEW | |
181 | ||
de54c5ab | 182 | if Ada_Version < Ada_2005 then |
4660e715 | 183 | Error_Msg_SP ("task interface is an Ada 2005 extension"); |
184 | Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); | |
185 | end if; | |
186 | ||
187 | Set_Interface_List (Task_Node, New_List); | |
188 | ||
189 | loop | |
190 | Append (P_Qualified_Simple_Name, Interface_List (Task_Node)); | |
191 | exit when Token /= Tok_And; | |
192 | Scan; -- past AND | |
193 | end loop; | |
194 | ||
195 | if Token /= Tok_With then | |
503f7fd3 | 196 | Error_Msg_SC -- CODEFIX |
197 | ("WITH expected"); | |
4660e715 | 198 | end if; |
199 | ||
200 | Scan; -- past WITH | |
9f373bb8 | 201 | |
202 | if Token = Tok_Private then | |
503f7fd3 | 203 | Error_Msg_SP -- CODEFIX |
9f373bb8 | 204 | ("PRIVATE not allowed in task type declaration"); |
205 | end if; | |
4660e715 | 206 | end if; |
207 | ||
ddf1337b | 208 | Set_Task_Definition (Task_Node, P_Task_Definition); |
49d882a7 | 209 | end if; |
210 | ||
211 | return Task_Node; | |
212 | end if; | |
213 | end P_Task; | |
214 | ||
215 | -------------------------------- | |
216 | -- 9.1 Task Type Declaration -- | |
217 | -------------------------------- | |
218 | ||
219 | -- Parsed by P_Task (9.1) | |
220 | ||
221 | ---------------------------------- | |
222 | -- 9.1 Single Task Declaration -- | |
223 | ---------------------------------- | |
224 | ||
225 | -- Parsed by P_Task (9.1) | |
226 | ||
227 | -------------------------- | |
228 | -- 9.1 Task Definition -- | |
229 | -------------------------- | |
230 | ||
231 | -- TASK_DEFINITION ::= | |
232 | -- {TASK_ITEM} | |
233 | -- [private | |
234 | -- {TASK_ITEM}] | |
235 | -- end [task_IDENTIFIER]; | |
236 | ||
237 | -- The caller has already made the scope stack entry | |
238 | ||
239 | -- Note: there is a small deviation from official syntax here in that we | |
240 | -- regard the semicolon after end as part of the Task_Definition, and in | |
241 | -- the official syntax, it's part of the enclosing declaration. The reason | |
242 | -- for this deviation is that otherwise the end processing would have to | |
243 | -- be special cased, which would be a nuisance! | |
244 | ||
245 | -- Error recovery: cannot raise Error_Resync | |
246 | ||
ddf1337b | 247 | function P_Task_Definition return Node_Id is |
49d882a7 | 248 | Def_Node : Node_Id; |
249 | ||
250 | begin | |
251 | Def_Node := New_Node (N_Task_Definition, Token_Ptr); | |
252 | Set_Visible_Declarations (Def_Node, P_Task_Items); | |
253 | ||
254 | if Token = Tok_Private then | |
255 | Scan; -- past PRIVATE | |
256 | Set_Private_Declarations (Def_Node, P_Task_Items); | |
257 | ||
258 | -- Deal gracefully with multiple PRIVATE parts | |
259 | ||
260 | while Token = Tok_Private loop | |
9f373bb8 | 261 | Error_Msg_SC ("only one private part allowed per task"); |
49d882a7 | 262 | Scan; -- past PRIVATE |
263 | Append_List (P_Task_Items, Private_Declarations (Def_Node)); | |
264 | end loop; | |
265 | end if; | |
266 | ||
ddf1337b | 267 | End_Statements (Def_Node); |
49d882a7 | 268 | return Def_Node; |
269 | end P_Task_Definition; | |
270 | ||
271 | -------------------- | |
272 | -- 9.1 Task Item -- | |
273 | -------------------- | |
274 | ||
275 | -- TASK_ITEM ::= ENTRY_DECLARATION | REPRESENTATION_CLAUSE | |
276 | ||
277 | -- This subprogram scans a (possibly empty) list of task items and pragmas | |
278 | ||
279 | -- Error recovery: cannot raise Error_Resync | |
280 | ||
281 | -- Note: a pragma can also be returned in this position | |
282 | ||
283 | function P_Task_Items return List_Id is | |
284 | Items : List_Id; | |
285 | Item_Node : Node_Id; | |
286 | Decl_Sloc : Source_Ptr; | |
287 | ||
288 | begin | |
289 | -- Get rid of active SIS entry from outer scope. This means we will | |
290 | -- miss some nested cases, but it doesn't seem worth the effort. See | |
291 | -- discussion in Par for further details | |
292 | ||
293 | SIS_Entry_Active := False; | |
294 | ||
295 | -- Loop to scan out task items | |
296 | ||
297 | Items := New_List; | |
298 | ||
299 | Decl_Loop : loop | |
300 | Decl_Sloc := Token_Ptr; | |
301 | ||
302 | if Token = Tok_Pragma then | |
303 | Append (P_Pragma, Items); | |
304 | ||
9f373bb8 | 305 | -- Ada 2005 (AI-397): Reserved words NOT and OVERRIDING |
306 | -- may begin an entry declaration. | |
307 | ||
308 | elsif Token = Tok_Entry | |
309 | or else Token = Tok_Not | |
310 | or else Token = Tok_Overriding | |
311 | then | |
49d882a7 | 312 | Append (P_Entry_Declaration, Items); |
313 | ||
314 | elsif Token = Tok_For then | |
315 | -- Representation clause in task declaration. The only rep | |
316 | -- clause which is legal in a protected is an address clause, | |
317 | -- so that is what we try to scan out. | |
318 | ||
319 | Item_Node := P_Representation_Clause; | |
320 | ||
321 | if Nkind (Item_Node) = N_At_Clause then | |
322 | Append (Item_Node, Items); | |
323 | ||
324 | elsif Nkind (Item_Node) = N_Attribute_Definition_Clause | |
325 | and then Chars (Item_Node) = Name_Address | |
326 | then | |
327 | Append (Item_Node, Items); | |
328 | ||
329 | else | |
330 | Error_Msg | |
331 | ("the only representation clause " & | |
332 | "allowed here is an address clause!", Decl_Sloc); | |
333 | end if; | |
334 | ||
335 | elsif Token = Tok_Identifier | |
336 | or else Token in Token_Class_Declk | |
337 | then | |
9f373bb8 | 338 | Error_Msg_SC ("illegal declaration in task definition"); |
49d882a7 | 339 | Resync_Past_Semicolon; |
340 | ||
341 | else | |
342 | exit Decl_Loop; | |
343 | end if; | |
344 | end loop Decl_Loop; | |
345 | ||
346 | return Items; | |
347 | end P_Task_Items; | |
348 | ||
349 | -------------------- | |
350 | -- 9.1 Task Body -- | |
351 | -------------------- | |
352 | ||
353 | -- Parsed by P_Task (9.1) | |
354 | ||
355 | ---------------------------------- | |
356 | -- 9.4 Protected (also 10.1.3) -- | |
357 | ---------------------------------- | |
358 | ||
359 | -- PROTECTED_TYPE_DECLARATION ::= | |
360 | -- protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART] | |
ddf1337b | 361 | -- [ASPECT_SPECIFICATIONS] |
362 | -- is [new INTERFACE_LIST with] PROTECTED_DEFINITION; | |
49d882a7 | 363 | |
364 | -- SINGLE_PROTECTED_DECLARATION ::= | |
8e8a39bd | 365 | -- protected DEFINING_IDENTIFIER |
ddf1337b | 366 | -- [ASPECT_SPECIFICATIONS] |
8e8a39bd | 367 | -- is [new INTERFACE_LIST with] PROTECTED_DEFINITION; |
49d882a7 | 368 | |
369 | -- PROTECTED_BODY ::= | |
370 | -- protected body DEFINING_IDENTIFIER is | |
371 | -- {PROTECTED_OPERATION_ITEM} | |
372 | -- end [protected_IDENTIFIER]; | |
373 | ||
374 | -- PROTECTED_BODY_STUB ::= | |
375 | -- protected body DEFINING_IDENTIFIER is separate; | |
376 | ||
377 | -- This routine scans out a protected declaration, protected body | |
378 | -- or a protected stub. | |
379 | ||
380 | -- The caller has checked that the initial token is PROTECTED and | |
381 | -- scanned past it, so Token is set to the following token. | |
382 | ||
383 | -- Error recovery: cannot raise Error_Resync | |
384 | ||
385 | function P_Protected return Node_Id is | |
386 | Name_Node : Node_Id; | |
387 | Protected_Node : Node_Id; | |
388 | Protected_Sloc : Source_Ptr; | |
9b6ead66 | 389 | Scan_State : Saved_Scan_State; |
49d882a7 | 390 | |
391 | begin | |
392 | Push_Scope_Stack; | |
393 | Scope.Table (Scope.Last).Etyp := E_Name; | |
394 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
395 | Scope.Table (Scope.Last).Lreq := False; | |
396 | Protected_Sloc := Prev_Token_Ptr; | |
397 | ||
398 | if Token = Tok_Body then | |
399 | Scan; -- past BODY | |
ec621b58 | 400 | Name_Node := P_Defining_Identifier (C_Is); |
49d882a7 | 401 | Scope.Table (Scope.Last).Labl := Name_Node; |
402 | ||
403 | if Token = Tok_Left_Paren then | |
404 | Error_Msg_SC ("discriminant part not allowed in protected body"); | |
405 | Discard_Junk_List (P_Known_Discriminant_Part_Opt); | |
406 | end if; | |
407 | ||
408 | TF_Is; | |
409 | ||
410 | -- Protected stub | |
411 | ||
412 | if Token = Tok_Separate then | |
413 | Scan; -- past SEPARATE | |
414 | Protected_Node := New_Node (N_Protected_Body_Stub, Protected_Sloc); | |
415 | Set_Defining_Identifier (Protected_Node, Name_Node); | |
416 | TF_Semicolon; | |
417 | Pop_Scope_Stack; -- remove unused entry | |
418 | ||
419 | -- Protected body | |
420 | ||
421 | else | |
422 | Protected_Node := New_Node (N_Protected_Body, Protected_Sloc); | |
423 | Set_Defining_Identifier (Protected_Node, Name_Node); | |
424 | Set_Declarations (Protected_Node, P_Protected_Operation_Items); | |
425 | End_Statements (Protected_Node); | |
426 | end if; | |
427 | ||
428 | return Protected_Node; | |
429 | ||
430 | -- Otherwise we must have a protected declaration | |
431 | ||
432 | else | |
433 | if Token = Tok_Type then | |
434 | Scan; -- past TYPE | |
435 | Protected_Node := | |
436 | New_Node (N_Protected_Type_Declaration, Protected_Sloc); | |
ec621b58 | 437 | Name_Node := P_Defining_Identifier (C_Is); |
49d882a7 | 438 | Set_Defining_Identifier (Protected_Node, Name_Node); |
439 | Scope.Table (Scope.Last).Labl := Name_Node; | |
440 | Set_Discriminant_Specifications | |
441 | (Protected_Node, P_Known_Discriminant_Part_Opt); | |
442 | ||
443 | else | |
444 | Protected_Node := | |
445 | New_Node (N_Single_Protected_Declaration, Protected_Sloc); | |
ec621b58 | 446 | Name_Node := P_Defining_Identifier (C_Is); |
49d882a7 | 447 | Set_Defining_Identifier (Protected_Node, Name_Node); |
448 | ||
449 | if Token = Tok_Left_Paren then | |
450 | Error_Msg_SC | |
451 | ("discriminant part not allowed for single protected"); | |
452 | Discard_Junk_List (P_Known_Discriminant_Part_Opt); | |
453 | end if; | |
454 | ||
455 | Scope.Table (Scope.Last).Labl := Name_Node; | |
456 | end if; | |
457 | ||
ddf1337b | 458 | P_Aspect_Specifications (Protected_Node, Semicolon => False); |
459 | ||
9b6ead66 | 460 | -- Check for semicolon not followed by IS, this is something like |
461 | ||
462 | -- protected type r; | |
463 | ||
464 | -- where we want | |
465 | ||
466 | -- protected type r IS END; | |
467 | ||
468 | if Token = Tok_Semicolon then | |
469 | Save_Scan_State (Scan_State); -- at semicolon | |
470 | Scan; -- past semicolon | |
471 | ||
472 | if Token /= Tok_Is then | |
473 | Restore_Scan_State (Scan_State); | |
503f7fd3 | 474 | Error_Msg_SC -- CODEFIX |
475 | ("missing IS"); | |
9b6ead66 | 476 | Set_Protected_Definition (Protected_Node, |
477 | Make_Protected_Definition (Token_Ptr, | |
478 | Visible_Declarations => Empty_List, | |
479 | End_Label => Empty)); | |
480 | ||
481 | SIS_Entry_Active := False; | |
30e864df | 482 | End_Statements |
483 | (Protected_Definition (Protected_Node), Protected_Node); | |
9b6ead66 | 484 | return Protected_Node; |
485 | end if; | |
486 | ||
503f7fd3 | 487 | Error_Msg_SP -- CODEFIX |
488 | ("|extra ""("" ignored"); | |
9b6ead66 | 489 | end if; |
490 | ||
49d882a7 | 491 | T_Is; |
4660e715 | 492 | |
493 | -- Ada 2005 (AI-345) | |
494 | ||
495 | if Token = Tok_New then | |
496 | Scan; -- past NEW | |
497 | ||
de54c5ab | 498 | if Ada_Version < Ada_2005 then |
e15291e5 | 499 | Error_Msg_SP ("protected interface is an Ada 2005 extension"); |
4660e715 | 500 | Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); |
501 | end if; | |
502 | ||
503 | Set_Interface_List (Protected_Node, New_List); | |
504 | ||
505 | loop | |
506 | Append (P_Qualified_Simple_Name, | |
507 | Interface_List (Protected_Node)); | |
508 | ||
509 | exit when Token /= Tok_And; | |
510 | Scan; -- past AND | |
511 | end loop; | |
512 | ||
513 | if Token /= Tok_With then | |
503f7fd3 | 514 | Error_Msg_SC -- CODEFIX |
515 | ("WITH expected"); | |
4660e715 | 516 | end if; |
517 | ||
518 | Scan; -- past WITH | |
519 | end if; | |
520 | ||
ddf1337b | 521 | Set_Protected_Definition (Protected_Node, P_Protected_Definition); |
49d882a7 | 522 | return Protected_Node; |
523 | end if; | |
524 | end P_Protected; | |
525 | ||
526 | ------------------------------------- | |
527 | -- 9.4 Protected Type Declaration -- | |
528 | ------------------------------------- | |
529 | ||
530 | -- Parsed by P_Protected (9.4) | |
531 | ||
532 | --------------------------------------- | |
533 | -- 9.4 Single Protected Declaration -- | |
534 | --------------------------------------- | |
535 | ||
536 | -- Parsed by P_Protected (9.4) | |
537 | ||
538 | ------------------------------- | |
539 | -- 9.4 Protected Definition -- | |
540 | ------------------------------- | |
541 | ||
542 | -- PROTECTED_DEFINITION ::= | |
543 | -- {PROTECTED_OPERATION_DECLARATION} | |
544 | -- [private | |
545 | -- {PROTECTED_ELEMENT_DECLARATION}] | |
546 | -- end [protected_IDENTIFIER] | |
547 | ||
548 | -- PROTECTED_ELEMENT_DECLARATION ::= | |
549 | -- PROTECTED_OPERATION_DECLARATION | |
550 | -- | COMPONENT_DECLARATION | |
551 | ||
552 | -- The caller has already established the scope stack entry | |
553 | ||
554 | -- Error recovery: cannot raise Error_Resync | |
555 | ||
ddf1337b | 556 | function P_Protected_Definition return Node_Id is |
49d882a7 | 557 | Def_Node : Node_Id; |
558 | Item_Node : Node_Id; | |
559 | ||
560 | begin | |
561 | Def_Node := New_Node (N_Protected_Definition, Token_Ptr); | |
562 | ||
563 | -- Get rid of active SIS entry from outer scope. This means we will | |
564 | -- miss some nested cases, but it doesn't seem worth the effort. See | |
565 | -- discussion in Par for further details | |
566 | ||
567 | SIS_Entry_Active := False; | |
568 | ||
569 | -- Loop to scan visible declarations (protected operation declarations) | |
570 | ||
571 | Set_Visible_Declarations (Def_Node, New_List); | |
572 | ||
573 | loop | |
574 | Item_Node := P_Protected_Operation_Declaration_Opt; | |
575 | exit when No (Item_Node); | |
576 | Append (Item_Node, Visible_Declarations (Def_Node)); | |
577 | end loop; | |
578 | ||
e15291e5 | 579 | -- Deal with PRIVATE part (including graceful handling of multiple |
580 | -- PRIVATE parts). | |
49d882a7 | 581 | |
582 | Private_Loop : while Token = Tok_Private loop | |
583 | if No (Private_Declarations (Def_Node)) then | |
584 | Set_Private_Declarations (Def_Node, New_List); | |
585 | else | |
586 | Error_Msg_SC ("duplicate private part"); | |
587 | end if; | |
588 | ||
589 | Scan; -- past PRIVATE | |
590 | ||
591 | Declaration_Loop : loop | |
592 | if Token = Tok_Identifier then | |
593 | P_Component_Items (Private_Declarations (Def_Node)); | |
594 | else | |
595 | Item_Node := P_Protected_Operation_Declaration_Opt; | |
596 | exit Declaration_Loop when No (Item_Node); | |
597 | Append (Item_Node, Private_Declarations (Def_Node)); | |
598 | end if; | |
599 | end loop Declaration_Loop; | |
600 | end loop Private_Loop; | |
601 | ||
ddf1337b | 602 | End_Statements (Def_Node); |
49d882a7 | 603 | return Def_Node; |
604 | end P_Protected_Definition; | |
605 | ||
606 | ------------------------------------------ | |
607 | -- 9.4 Protected Operation Declaration -- | |
608 | ------------------------------------------ | |
609 | ||
610 | -- PROTECTED_OPERATION_DECLARATION ::= | |
611 | -- SUBPROGRAM_DECLARATION | |
612 | -- | ENTRY_DECLARATION | |
613 | -- | REPRESENTATION_CLAUSE | |
614 | ||
615 | -- Error recovery: cannot raise Error_Resync | |
616 | ||
617 | -- Note: a pragma can also be returned in this position | |
618 | ||
619 | -- We are not currently permitting representation clauses to appear as | |
620 | -- protected operation declarations, do we have to rethink this??? | |
621 | ||
622 | function P_Protected_Operation_Declaration_Opt return Node_Id is | |
623 | L : List_Id; | |
624 | P : Source_Ptr; | |
625 | ||
9f373bb8 | 626 | function P_Entry_Or_Subprogram_With_Indicator return Node_Id; |
627 | -- Ada 2005 (AI-397): Parse an entry or a subprogram with an overriding | |
628 | -- indicator. The caller has checked that the initial token is NOT or | |
629 | -- OVERRIDING. | |
630 | ||
631 | ------------------------------------------ | |
632 | -- P_Entry_Or_Subprogram_With_Indicator -- | |
633 | ------------------------------------------ | |
634 | ||
635 | function P_Entry_Or_Subprogram_With_Indicator return Node_Id is | |
636 | Decl : Node_Id := Error; | |
637 | Is_Overriding : Boolean := False; | |
638 | Not_Overriding : Boolean := False; | |
639 | ||
640 | begin | |
641 | if Token = Tok_Not then | |
642 | Scan; -- past NOT | |
643 | ||
644 | if Token = Tok_Overriding then | |
645 | Scan; -- past OVERRIDING | |
646 | Not_Overriding := True; | |
647 | else | |
503f7fd3 | 648 | Error_Msg_SC -- CODEFIX |
649 | ("OVERRIDING expected!"); | |
9f373bb8 | 650 | end if; |
651 | ||
652 | else | |
653 | Scan; -- past OVERRIDING | |
654 | Is_Overriding := True; | |
655 | end if; | |
656 | ||
ff78da98 | 657 | if Is_Overriding or else Not_Overriding then |
de54c5ab | 658 | if Ada_Version < Ada_2005 then |
4a172c0c | 659 | Error_Msg_SP ("overriding indicator is an Ada 2005 extension"); |
9f373bb8 | 660 | Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); |
661 | ||
662 | elsif Token = Tok_Entry then | |
663 | Decl := P_Entry_Declaration; | |
664 | ||
665 | Set_Must_Override (Decl, Is_Overriding); | |
666 | Set_Must_Not_Override (Decl, Not_Overriding); | |
667 | ||
668 | elsif Token = Tok_Function or else Token = Tok_Procedure then | |
afac5216 | 669 | Decl := P_Subprogram (Pf_Decl_Pexp); |
9f373bb8 | 670 | |
671 | Set_Must_Override (Specification (Decl), Is_Overriding); | |
672 | Set_Must_Not_Override (Specification (Decl), Not_Overriding); | |
673 | ||
674 | else | |
a6252fe0 | 675 | Error_Msg_SC -- CODEFIX |
676 | ("ENTRY, FUNCTION or PROCEDURE expected!"); | |
9f373bb8 | 677 | end if; |
678 | end if; | |
679 | ||
680 | return Decl; | |
681 | end P_Entry_Or_Subprogram_With_Indicator; | |
682 | ||
683 | -- Start of processing for P_Protected_Operation_Declaration_Opt | |
684 | ||
49d882a7 | 685 | begin |
686 | -- This loop runs more than once only when a junk declaration | |
687 | -- is skipped. | |
688 | ||
689 | loop | |
690 | if Token = Tok_Pragma then | |
691 | return P_Pragma; | |
692 | ||
9f373bb8 | 693 | elsif Token = Tok_Not or else Token = Tok_Overriding then |
694 | return P_Entry_Or_Subprogram_With_Indicator; | |
695 | ||
49d882a7 | 696 | elsif Token = Tok_Entry then |
697 | return P_Entry_Declaration; | |
698 | ||
699 | elsif Token = Tok_Function or else Token = Tok_Procedure then | |
afac5216 | 700 | return P_Subprogram (Pf_Decl_Pexp); |
49d882a7 | 701 | |
702 | elsif Token = Tok_Identifier then | |
703 | L := New_List; | |
704 | P := Token_Ptr; | |
705 | Skip_Declaration (L); | |
706 | ||
707 | if Nkind (First (L)) = N_Object_Declaration then | |
708 | Error_Msg | |
709 | ("component must be declared in private part of " & | |
710 | "protected type", P); | |
711 | else | |
712 | Error_Msg | |
713 | ("illegal declaration in protected definition", P); | |
714 | end if; | |
715 | ||
716 | elsif Token in Token_Class_Declk then | |
717 | Error_Msg_SC ("illegal declaration in protected definition"); | |
718 | Resync_Past_Semicolon; | |
719 | ||
720 | -- Return now to avoid cascaded messages if next declaration | |
721 | -- is a valid component declaration. | |
722 | ||
723 | return Error; | |
724 | ||
725 | elsif Token = Tok_For then | |
726 | Error_Msg_SC | |
727 | ("representation clause not allowed in protected definition"); | |
728 | Resync_Past_Semicolon; | |
729 | ||
730 | else | |
731 | return Empty; | |
732 | end if; | |
733 | end loop; | |
734 | end P_Protected_Operation_Declaration_Opt; | |
735 | ||
736 | ----------------------------------- | |
737 | -- 9.4 Protected Operation Item -- | |
738 | ----------------------------------- | |
739 | ||
740 | -- PROTECTED_OPERATION_ITEM ::= | |
741 | -- SUBPROGRAM_DECLARATION | |
742 | -- | SUBPROGRAM_BODY | |
743 | -- | ENTRY_BODY | |
744 | -- | REPRESENTATION_CLAUSE | |
745 | ||
746 | -- This procedure parses and returns a list of protected operation items | |
747 | ||
748 | -- We are not currently permitting representation clauses to appear | |
749 | -- as protected operation items, do we have to rethink this??? | |
750 | ||
751 | function P_Protected_Operation_Items return List_Id is | |
752 | Item_List : List_Id; | |
753 | ||
754 | begin | |
755 | Item_List := New_List; | |
756 | ||
757 | loop | |
758 | if Token = Tok_Entry or else Bad_Spelling_Of (Tok_Entry) then | |
759 | Append (P_Entry_Body, Item_List); | |
760 | ||
557df72f | 761 | -- If the operation starts with procedure, function, or an overriding |
762 | -- indicator ("overriding" or "not overriding"), parse a subprogram. | |
763 | ||
49d882a7 | 764 | elsif Token = Tok_Function or else Bad_Spelling_Of (Tok_Function) |
765 | or else | |
766 | Token = Tok_Procedure or else Bad_Spelling_Of (Tok_Procedure) | |
557df72f | 767 | or else |
768 | Token = Tok_Overriding or else Bad_Spelling_Of (Tok_Overriding) | |
769 | or else | |
770 | Token = Tok_Not or else Bad_Spelling_Of (Tok_Not) | |
49d882a7 | 771 | then |
afac5216 | 772 | Append (P_Subprogram (Pf_Decl_Pbod_Pexp), Item_List); |
49d882a7 | 773 | |
774 | elsif Token = Tok_Pragma or else Bad_Spelling_Of (Tok_Pragma) then | |
775 | P_Pragmas_Opt (Item_List); | |
776 | ||
777 | elsif Token = Tok_Private or else Bad_Spelling_Of (Tok_Private) then | |
778 | Error_Msg_SC ("PRIVATE not allowed in protected body"); | |
779 | Scan; -- past PRIVATE | |
780 | ||
781 | elsif Token = Tok_Identifier then | |
503f7fd3 | 782 | Error_Msg_SC ("all components must be declared in spec!"); |
49d882a7 | 783 | Resync_Past_Semicolon; |
784 | ||
785 | elsif Token in Token_Class_Declk then | |
786 | Error_Msg_SC ("this declaration not allowed in protected body"); | |
787 | Resync_Past_Semicolon; | |
788 | ||
789 | else | |
790 | exit; | |
791 | end if; | |
792 | end loop; | |
793 | ||
794 | return Item_List; | |
795 | end P_Protected_Operation_Items; | |
796 | ||
797 | ------------------------------ | |
798 | -- 9.5.2 Entry Declaration -- | |
799 | ------------------------------ | |
800 | ||
801 | -- ENTRY_DECLARATION ::= | |
9f373bb8 | 802 | -- [OVERRIDING_INDICATOR] |
49d882a7 | 803 | -- entry DEFINING_IDENTIFIER [(DISCRETE_SUBTYPE_DEFINITION)] |
804 | -- PARAMETER_PROFILE; | |
ebce244f | 805 | -- [ASPECT_SPECIFICATIONS]; |
49d882a7 | 806 | |
9f373bb8 | 807 | -- The caller has checked that the initial token is ENTRY, NOT or |
808 | -- OVERRIDING. | |
49d882a7 | 809 | |
810 | -- Error recovery: cannot raise Error_Resync | |
811 | ||
812 | function P_Entry_Declaration return Node_Id is | |
813 | Decl_Node : Node_Id; | |
814 | Scan_State : Saved_Scan_State; | |
815 | ||
9f373bb8 | 816 | -- Flags for optional overriding indication. Two flags are needed, |
817 | -- to distinguish positive and negative overriding indicators from | |
818 | -- the absence of any indicator. | |
819 | ||
820 | Is_Overriding : Boolean := False; | |
821 | Not_Overriding : Boolean := False; | |
822 | ||
49d882a7 | 823 | begin |
3817baeb | 824 | -- Ada 2005 (AI-397): Scan leading overriding indicator |
9f373bb8 | 825 | |
826 | if Token = Tok_Not then | |
827 | Scan; -- past NOT | |
828 | ||
829 | if Token = Tok_Overriding then | |
830 | Scan; -- part OVERRIDING | |
831 | Not_Overriding := True; | |
832 | else | |
503f7fd3 | 833 | Error_Msg_SC -- CODEFIX |
834 | ("OVERRIDING expected!"); | |
9f373bb8 | 835 | end if; |
836 | ||
837 | elsif Token = Tok_Overriding then | |
838 | Scan; -- part OVERRIDING | |
839 | Is_Overriding := True; | |
840 | end if; | |
841 | ||
ff78da98 | 842 | if Is_Overriding or else Not_Overriding then |
de54c5ab | 843 | if Ada_Version < Ada_2005 then |
4a172c0c | 844 | Error_Msg_SP ("overriding indicator is an Ada 2005 extension"); |
9f373bb8 | 845 | Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); |
846 | ||
847 | elsif Token /= Tok_Entry then | |
503f7fd3 | 848 | Error_Msg_SC -- CODEFIX |
849 | ("ENTRY expected!"); | |
9f373bb8 | 850 | end if; |
851 | end if; | |
852 | ||
49d882a7 | 853 | Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr); |
854 | Scan; -- past ENTRY | |
855 | ||
ec621b58 | 856 | Set_Defining_Identifier |
857 | (Decl_Node, P_Defining_Identifier (C_Left_Paren_Semicolon)); | |
49d882a7 | 858 | |
859 | -- If left paren, could be (Discrete_Subtype_Definition) or Formal_Part | |
860 | ||
861 | if Token = Tok_Left_Paren then | |
862 | Scan; -- past ( | |
863 | ||
864 | -- If identifier after left paren, could still be either | |
865 | ||
866 | if Token = Tok_Identifier then | |
867 | Save_Scan_State (Scan_State); -- at Id | |
868 | Scan; -- past Id | |
869 | ||
870 | -- If comma or colon after Id, must be Formal_Part | |
871 | ||
872 | if Token = Tok_Comma or else Token = Tok_Colon then | |
873 | Restore_Scan_State (Scan_State); -- to Id | |
874 | Set_Parameter_Specifications (Decl_Node, P_Formal_Part); | |
875 | ||
27f48659 | 876 | -- Else if Id without comma or colon, must be discrete subtype |
877 | -- defn | |
49d882a7 | 878 | |
879 | else | |
880 | Restore_Scan_State (Scan_State); -- to Id | |
881 | Set_Discrete_Subtype_Definition | |
882 | (Decl_Node, P_Discrete_Subtype_Definition); | |
883 | T_Right_Paren; | |
884 | Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile); | |
885 | end if; | |
886 | ||
887 | -- If no Id, must be discrete subtype definition | |
888 | ||
889 | else | |
890 | Set_Discrete_Subtype_Definition | |
891 | (Decl_Node, P_Discrete_Subtype_Definition); | |
892 | T_Right_Paren; | |
893 | Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile); | |
894 | end if; | |
895 | end if; | |
896 | ||
9f373bb8 | 897 | if Is_Overriding then |
898 | Set_Must_Override (Decl_Node); | |
899 | elsif Not_Overriding then | |
900 | Set_Must_Not_Override (Decl_Node); | |
901 | end if; | |
902 | ||
49d882a7 | 903 | -- Error recovery check for illegal return |
904 | ||
905 | if Token = Tok_Return then | |
906 | Error_Msg_SC ("entry cannot have return value!"); | |
907 | Scan; | |
908 | Discard_Junk_Node (P_Subtype_Indication); | |
909 | end if; | |
910 | ||
911 | -- Error recovery check for improper use of entry barrier in spec | |
912 | ||
913 | if Token = Tok_When then | |
914 | Error_Msg_SC ("barrier not allowed here (belongs in body)"); | |
915 | Scan; -- past WHEN; | |
916 | Discard_Junk_Node (P_Expression_No_Right_Paren); | |
917 | end if; | |
918 | ||
ae888dbd | 919 | P_Aspect_Specifications (Decl_Node); |
49d882a7 | 920 | return Decl_Node; |
8e8a39bd | 921 | |
922 | exception | |
923 | when Error_Resync => | |
924 | Resync_Past_Semicolon; | |
925 | return Error; | |
49d882a7 | 926 | end P_Entry_Declaration; |
927 | ||
928 | ----------------------------- | |
929 | -- 9.5.2 Accept Statement -- | |
930 | ----------------------------- | |
931 | ||
932 | -- ACCEPT_STATEMENT ::= | |
933 | -- accept entry_DIRECT_NAME | |
934 | -- [(ENTRY_INDEX)] PARAMETER_PROFILE [do | |
935 | -- HANDLED_SEQUENCE_OF_STATEMENTS | |
936 | -- end [entry_IDENTIFIER]]; | |
937 | ||
938 | -- The caller has checked that the initial token is ACCEPT | |
939 | ||
940 | -- Error recovery: cannot raise Error_Resync. If an error occurs, the | |
941 | -- scan is resynchronized past the next semicolon and control returns. | |
942 | ||
943 | function P_Accept_Statement return Node_Id is | |
944 | Scan_State : Saved_Scan_State; | |
945 | Accept_Node : Node_Id; | |
946 | Hand_Seq : Node_Id; | |
947 | ||
948 | begin | |
949 | Push_Scope_Stack; | |
950 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
951 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
952 | ||
953 | Accept_Node := New_Node (N_Accept_Statement, Token_Ptr); | |
954 | Scan; -- past ACCEPT | |
955 | Scope.Table (Scope.Last).Labl := Token_Node; | |
956 | ||
ec621b58 | 957 | Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do)); |
49d882a7 | 958 | |
959 | -- Left paren could be (Entry_Index) or Formal_Part, determine which | |
960 | ||
961 | if Token = Tok_Left_Paren then | |
962 | Save_Scan_State (Scan_State); -- at left paren | |
963 | Scan; -- past left paren | |
964 | ||
965 | -- If first token after left paren not identifier, then Entry_Index | |
966 | ||
967 | if Token /= Tok_Identifier then | |
968 | Set_Entry_Index (Accept_Node, P_Expression); | |
969 | T_Right_Paren; | |
970 | Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile); | |
971 | ||
972 | -- First token after left paren is identifier, could be either case | |
973 | ||
974 | else -- Token = Tok_Identifier | |
975 | Scan; -- past identifier | |
976 | ||
977 | -- If identifier followed by comma or colon, must be Formal_Part | |
978 | ||
979 | if Token = Tok_Comma or else Token = Tok_Colon then | |
980 | Restore_Scan_State (Scan_State); -- to left paren | |
981 | Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile); | |
982 | ||
983 | -- If identifier not followed by comma/colon, must be entry index | |
984 | ||
985 | else | |
986 | Restore_Scan_State (Scan_State); -- to left paren | |
987 | Scan; -- past left paren (again!) | |
988 | Set_Entry_Index (Accept_Node, P_Expression); | |
989 | T_Right_Paren; | |
990 | Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile); | |
991 | end if; | |
992 | end if; | |
993 | end if; | |
994 | ||
995 | -- Scan out DO if present | |
996 | ||
997 | if Token = Tok_Do then | |
998 | Scope.Table (Scope.Last).Etyp := E_Name; | |
999 | Scope.Table (Scope.Last).Lreq := False; | |
1000 | Scan; -- past DO | |
1001 | Hand_Seq := P_Handled_Sequence_Of_Statements; | |
1002 | Set_Handled_Statement_Sequence (Accept_Node, Hand_Seq); | |
1003 | End_Statements (Handled_Statement_Sequence (Accept_Node)); | |
1004 | ||
1005 | -- Exception handlers not allowed in Ada 95 node | |
1006 | ||
1007 | if Present (Exception_Handlers (Hand_Seq)) then | |
e2aa7314 | 1008 | if Ada_Version = Ada_83 then |
49d882a7 | 1009 | Error_Msg_N |
1010 | ("(Ada 83) exception handlers in accept not allowed", | |
1011 | First_Non_Pragma (Exception_Handlers (Hand_Seq))); | |
1012 | end if; | |
1013 | end if; | |
1014 | ||
1015 | else | |
1016 | Pop_Scope_Stack; -- discard unused entry | |
1017 | TF_Semicolon; | |
1018 | end if; | |
1019 | ||
1020 | return Accept_Node; | |
1021 | ||
1022 | -- If error, resynchronize past semicolon | |
1023 | ||
1024 | exception | |
1025 | when Error_Resync => | |
1026 | Resync_Past_Semicolon; | |
9dfe12ae | 1027 | Pop_Scope_Stack; -- discard unused entry |
49d882a7 | 1028 | return Error; |
1029 | ||
1030 | end P_Accept_Statement; | |
1031 | ||
1032 | ------------------------ | |
1033 | -- 9.5.2 Entry Index -- | |
1034 | ------------------------ | |
1035 | ||
1036 | -- Parsed by P_Expression (4.4) | |
1037 | ||
1038 | ----------------------- | |
1039 | -- 9.5.2 Entry Body -- | |
1040 | ----------------------- | |
1041 | ||
1042 | -- ENTRY_BODY ::= | |
1043 | -- entry DEFINING_IDENTIFIER ENTRY_BODY_FORMAL_PART ENTRY_BARRIER is | |
1044 | -- DECLARATIVE_PART | |
1045 | -- begin | |
1046 | -- HANDLED_SEQUENCE_OF_STATEMENTS | |
1047 | -- end [entry_IDENTIFIER]; | |
1048 | ||
1049 | -- The caller has checked that the initial token is ENTRY | |
1050 | ||
1051 | -- Error_Recovery: cannot raise Error_Resync | |
1052 | ||
1053 | function P_Entry_Body return Node_Id is | |
1054 | Entry_Node : Node_Id; | |
1055 | Formal_Part_Node : Node_Id; | |
1056 | Name_Node : Node_Id; | |
1057 | ||
1058 | begin | |
1059 | Push_Scope_Stack; | |
1060 | Entry_Node := New_Node (N_Entry_Body, Token_Ptr); | |
1061 | Scan; -- past ENTRY | |
1062 | ||
1063 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
1064 | Scope.Table (Scope.Last).Lreq := False; | |
1065 | Scope.Table (Scope.Last).Etyp := E_Name; | |
df9048c5 | 1066 | Scope.Table (Scope.Last).Sloc := Token_Ptr; |
49d882a7 | 1067 | |
1068 | Name_Node := P_Defining_Identifier; | |
1069 | Set_Defining_Identifier (Entry_Node, Name_Node); | |
1070 | Scope.Table (Scope.Last).Labl := Name_Node; | |
1071 | ||
1072 | Formal_Part_Node := P_Entry_Body_Formal_Part; | |
1073 | Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node); | |
1074 | ||
1075 | Set_Condition (Formal_Part_Node, P_Entry_Barrier); | |
1076 | Parse_Decls_Begin_End (Entry_Node); | |
1077 | return Entry_Node; | |
1078 | end P_Entry_Body; | |
1079 | ||
1080 | ----------------------------------- | |
1081 | -- 9.5.2 Entry Body Formal Part -- | |
1082 | ----------------------------------- | |
1083 | ||
1084 | -- ENTRY_BODY_FORMAL_PART ::= | |
1085 | -- [(ENTRY_INDEX_SPECIFICATION)] [PARAMETER_PART] | |
1086 | ||
1087 | -- Error_Recovery: cannot raise Error_Resync | |
1088 | ||
1089 | function P_Entry_Body_Formal_Part return Node_Id is | |
1090 | Fpart_Node : Node_Id; | |
1091 | Scan_State : Saved_Scan_State; | |
1092 | ||
1093 | begin | |
1094 | Fpart_Node := New_Node (N_Entry_Body_Formal_Part, Token_Ptr); | |
1095 | ||
1096 | -- See if entry index specification present, and if so parse it | |
1097 | ||
1098 | if Token = Tok_Left_Paren then | |
1099 | Save_Scan_State (Scan_State); -- at left paren | |
1100 | Scan; -- past left paren | |
1101 | ||
1102 | if Token = Tok_For then | |
1103 | Set_Entry_Index_Specification | |
1104 | (Fpart_Node, P_Entry_Index_Specification); | |
1105 | T_Right_Paren; | |
1106 | else | |
1107 | Restore_Scan_State (Scan_State); -- to left paren | |
1108 | end if; | |
1109 | ||
1110 | -- Check for (common?) case of left paren omitted before FOR. This | |
1111 | -- is a tricky case, because the corresponding missing left paren | |
1112 | -- can cause real havoc if a formal part is present which gets | |
1113 | -- treated as part of the discrete subtype definition of the | |
1114 | -- entry index specification, so just give error and resynchronize | |
1115 | ||
1116 | elsif Token = Tok_For then | |
1117 | T_Left_Paren; -- to give error message | |
1118 | Resync_To_When; | |
1119 | end if; | |
1120 | ||
1121 | Set_Parameter_Specifications (Fpart_Node, P_Parameter_Profile); | |
1122 | return Fpart_Node; | |
1123 | end P_Entry_Body_Formal_Part; | |
1124 | ||
1125 | -------------------------- | |
1126 | -- 9.5.2 Entry Barrier -- | |
1127 | -------------------------- | |
1128 | ||
1129 | -- ENTRY_BARRIER ::= when CONDITION | |
1130 | ||
1131 | -- Error_Recovery: cannot raise Error_Resync | |
1132 | ||
1133 | function P_Entry_Barrier return Node_Id is | |
1134 | Bnode : Node_Id; | |
1135 | ||
1136 | begin | |
1137 | if Token = Tok_When then | |
1138 | Scan; -- past WHEN; | |
1139 | Bnode := P_Expression_No_Right_Paren; | |
1140 | ||
1141 | if Token = Tok_Colon_Equal then | |
503f7fd3 | 1142 | Error_Msg_SC -- CODEFIX |
1143 | ("|"":="" should be ""="""); | |
49d882a7 | 1144 | Scan; |
1145 | Bnode := P_Expression_No_Right_Paren; | |
1146 | end if; | |
1147 | ||
1148 | else | |
1149 | T_When; -- to give error message | |
1150 | Bnode := Error; | |
1151 | end if; | |
1152 | ||
1153 | TF_Is; | |
1154 | return Bnode; | |
1155 | end P_Entry_Barrier; | |
1156 | ||
1157 | -------------------------------------- | |
1158 | -- 9.5.2 Entry Index Specification -- | |
1159 | -------------------------------------- | |
1160 | ||
1161 | -- ENTRY_INDEX_SPECIFICATION ::= | |
1162 | -- for DEFINING_IDENTIFIER in DISCRETE_SUBTYPE_DEFINITION | |
1163 | ||
1164 | -- Error recovery: can raise Error_Resync | |
1165 | ||
1166 | function P_Entry_Index_Specification return Node_Id is | |
1167 | Iterator_Node : Node_Id; | |
1168 | ||
1169 | begin | |
1170 | Iterator_Node := New_Node (N_Entry_Index_Specification, Token_Ptr); | |
1171 | T_For; -- past FOR | |
ec621b58 | 1172 | Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier (C_In)); |
49d882a7 | 1173 | T_In; |
1174 | Set_Discrete_Subtype_Definition | |
1175 | (Iterator_Node, P_Discrete_Subtype_Definition); | |
1176 | return Iterator_Node; | |
1177 | end P_Entry_Index_Specification; | |
1178 | ||
1179 | --------------------------------- | |
1180 | -- 9.5.3 Entry Call Statement -- | |
1181 | --------------------------------- | |
1182 | ||
1183 | -- Parsed by P_Name (4.1). Within a select, an entry call is parsed | |
1184 | -- by P_Select_Statement (9.7) | |
1185 | ||
1186 | ------------------------------ | |
1187 | -- 9.5.4 Requeue Statement -- | |
1188 | ------------------------------ | |
1189 | ||
1190 | -- REQUEUE_STATEMENT ::= requeue entry_NAME [with abort]; | |
1191 | ||
1192 | -- The caller has checked that the initial token is requeue | |
1193 | ||
1194 | -- Error recovery: can raise Error_Resync | |
1195 | ||
1196 | function P_Requeue_Statement return Node_Id is | |
1197 | Requeue_Node : Node_Id; | |
1198 | ||
1199 | begin | |
1200 | Requeue_Node := New_Node (N_Requeue_Statement, Token_Ptr); | |
1201 | Scan; -- past REQUEUE | |
1202 | Set_Name (Requeue_Node, P_Name); | |
1203 | ||
1204 | if Token = Tok_With then | |
1205 | Scan; -- past WITH | |
1206 | T_Abort; | |
1207 | Set_Abort_Present (Requeue_Node, True); | |
1208 | end if; | |
1209 | ||
1210 | TF_Semicolon; | |
1211 | return Requeue_Node; | |
1212 | end P_Requeue_Statement; | |
1213 | ||
1214 | -------------------------- | |
1215 | -- 9.6 Delay Statement -- | |
1216 | -------------------------- | |
1217 | ||
1218 | -- DELAY_STATEMENT ::= | |
1219 | -- DELAY_UNTIL_STATEMENT | |
1220 | -- | DELAY_RELATIVE_STATEMENT | |
1221 | ||
1222 | -- The caller has checked that the initial token is DELAY | |
1223 | ||
1224 | -- Error recovery: cannot raise Error_Resync | |
1225 | ||
1226 | function P_Delay_Statement return Node_Id is | |
1227 | begin | |
1228 | Scan; -- past DELAY | |
1229 | ||
1230 | -- The following check for delay until misused in Ada 83 doesn't catch | |
1231 | -- all cases, but it's good enough to catch most of them! | |
1232 | ||
1233 | if Token_Name = Name_Until then | |
1234 | Check_95_Keyword (Tok_Until, Tok_Left_Paren); | |
1235 | Check_95_Keyword (Tok_Until, Tok_Identifier); | |
1236 | end if; | |
1237 | ||
1238 | if Token = Tok_Until then | |
1239 | return P_Delay_Until_Statement; | |
1240 | else | |
1241 | return P_Delay_Relative_Statement; | |
1242 | end if; | |
1243 | end P_Delay_Statement; | |
1244 | ||
1245 | -------------------------------- | |
1246 | -- 9.6 Delay Until Statement -- | |
1247 | -------------------------------- | |
1248 | ||
1249 | -- DELAY_UNTIL_STATEMENT ::= delay until delay_EXPRESSION; | |
1250 | ||
1251 | -- The caller has checked that the initial token is DELAY, scanned it | |
1252 | -- out and checked that the current token is UNTIL | |
1253 | ||
1254 | -- Error recovery: cannot raise Error_Resync | |
1255 | ||
1256 | function P_Delay_Until_Statement return Node_Id is | |
1257 | Delay_Node : Node_Id; | |
1258 | ||
1259 | begin | |
1260 | Delay_Node := New_Node (N_Delay_Until_Statement, Prev_Token_Ptr); | |
1261 | Scan; -- past UNTIL | |
1262 | Set_Expression (Delay_Node, P_Expression_No_Right_Paren); | |
1263 | TF_Semicolon; | |
1264 | return Delay_Node; | |
1265 | end P_Delay_Until_Statement; | |
1266 | ||
1267 | ----------------------------------- | |
1268 | -- 9.6 Delay Relative Statement -- | |
1269 | ----------------------------------- | |
1270 | ||
1271 | -- DELAY_RELATIVE_STATEMENT ::= delay delay_EXPRESSION; | |
1272 | ||
1273 | -- The caller has checked that the initial token is DELAY, scanned it | |
1274 | -- out and determined that the current token is not UNTIL | |
1275 | ||
1276 | -- Error recovery: cannot raise Error_Resync | |
1277 | ||
1278 | function P_Delay_Relative_Statement return Node_Id is | |
1279 | Delay_Node : Node_Id; | |
1280 | ||
1281 | begin | |
1282 | Delay_Node := New_Node (N_Delay_Relative_Statement, Prev_Token_Ptr); | |
1283 | Set_Expression (Delay_Node, P_Expression_No_Right_Paren); | |
1284 | Check_Simple_Expression_In_Ada_83 (Expression (Delay_Node)); | |
1285 | TF_Semicolon; | |
1286 | return Delay_Node; | |
1287 | end P_Delay_Relative_Statement; | |
1288 | ||
1289 | --------------------------- | |
1290 | -- 9.7 Select Statement -- | |
1291 | --------------------------- | |
1292 | ||
1293 | -- SELECT_STATEMENT ::= | |
1294 | -- SELECTIVE_ACCEPT | |
1295 | -- | TIMED_ENTRY_CALL | |
1296 | -- | CONDITIONAL_ENTRY_CALL | |
1297 | -- | ASYNCHRONOUS_SELECT | |
1298 | ||
1299 | -- SELECTIVE_ACCEPT ::= | |
1300 | -- select | |
1301 | -- [GUARD] | |
1302 | -- SELECT_ALTERNATIVE | |
1303 | -- {or | |
1304 | -- [GUARD] | |
1305 | -- SELECT_ALTERNATIVE | |
1306 | -- [else | |
1307 | -- SEQUENCE_OF_STATEMENTS] | |
1308 | -- end select; | |
1309 | ||
1310 | -- GUARD ::= when CONDITION => | |
1311 | ||
1312 | -- Note: the guard preceding a select alternative is included as part | |
1313 | -- of the node generated for a selective accept alternative. | |
1314 | ||
1315 | -- SELECT_ALTERNATIVE ::= | |
1316 | -- ACCEPT_ALTERNATIVE | |
1317 | -- | DELAY_ALTERNATIVE | |
1318 | -- | TERMINATE_ALTERNATIVE | |
1319 | ||
1320 | -- TIMED_ENTRY_CALL ::= | |
1321 | -- select | |
1322 | -- ENTRY_CALL_ALTERNATIVE | |
1323 | -- or | |
1324 | -- DELAY_ALTERNATIVE | |
1325 | -- end select; | |
1326 | ||
1327 | -- CONDITIONAL_ENTRY_CALL ::= | |
1328 | -- select | |
1329 | -- ENTRY_CALL_ALTERNATIVE | |
1330 | -- else | |
1331 | -- SEQUENCE_OF_STATEMENTS | |
1332 | -- end select; | |
1333 | ||
1334 | -- ENTRY_CALL_ALTERNATIVE ::= | |
1335 | -- ENTRY_CALL_STATEMENT [SEQUENCE_OF_STATEMENTS] | |
1336 | ||
1337 | -- ASYNCHRONOUS_SELECT ::= | |
1338 | -- select | |
1339 | -- TRIGGERING_ALTERNATIVE | |
1340 | -- then abort | |
1341 | -- ABORTABLE_PART | |
1342 | -- end select; | |
1343 | ||
1344 | -- TRIGGERING_ALTERNATIVE ::= | |
1345 | -- TRIGGERING_STATEMENT [SEQUENCE_OF_STATEMENTS] | |
1346 | ||
1347 | -- TRIGGERING_STATEMENT ::= ENTRY_CALL_STATEMENT | DELAY_STATEMENT | |
1348 | ||
1349 | -- The caller has checked that the initial token is SELECT | |
1350 | ||
1351 | -- Error recovery: can raise Error_Resync | |
1352 | ||
1353 | function P_Select_Statement return Node_Id is | |
1354 | Select_Node : Node_Id; | |
1355 | Select_Sloc : Source_Ptr; | |
1356 | Stmnt_Sloc : Source_Ptr; | |
1357 | Ecall_Node : Node_Id; | |
1358 | Alternative : Node_Id; | |
1359 | Select_Pragmas : List_Id; | |
1360 | Alt_Pragmas : List_Id; | |
1361 | Statement_List : List_Id; | |
1362 | Alt_List : List_Id; | |
1363 | Cond_Expr : Node_Id; | |
1364 | Delay_Stmnt : Node_Id; | |
1365 | ||
1366 | begin | |
1367 | Push_Scope_Stack; | |
1368 | Scope.Table (Scope.Last).Etyp := E_Select; | |
1369 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
1370 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
1371 | Scope.Table (Scope.Last).Labl := Error; | |
1372 | ||
1373 | Select_Sloc := Token_Ptr; | |
1374 | Scan; -- past SELECT | |
1375 | Stmnt_Sloc := Token_Ptr; | |
1376 | Select_Pragmas := P_Pragmas_Opt; | |
1377 | ||
1378 | -- If first token after select is designator, then we have an entry | |
1379 | -- call, which must be the start of a conditional entry call, timed | |
1380 | -- entry call or asynchronous select | |
1381 | ||
1382 | if Token in Token_Class_Desig then | |
1383 | ||
1384 | -- Scan entry call statement | |
1385 | ||
1386 | begin | |
1387 | Ecall_Node := P_Name; | |
1388 | ||
1389 | -- ?? The following two clauses exactly parallel code in ch5 | |
27f48659 | 1390 | -- and should be combined sometime |
49d882a7 | 1391 | |
1392 | if Nkind (Ecall_Node) = N_Indexed_Component then | |
1393 | declare | |
9dfe12ae | 1394 | Prefix_Node : constant Node_Id := Prefix (Ecall_Node); |
1395 | Exprs_Node : constant List_Id := Expressions (Ecall_Node); | |
1396 | ||
49d882a7 | 1397 | begin |
1398 | Change_Node (Ecall_Node, N_Procedure_Call_Statement); | |
1399 | Set_Name (Ecall_Node, Prefix_Node); | |
1400 | Set_Parameter_Associations (Ecall_Node, Exprs_Node); | |
1401 | end; | |
1402 | ||
1403 | elsif Nkind (Ecall_Node) = N_Function_Call then | |
1404 | declare | |
9dfe12ae | 1405 | Fname_Node : constant Node_Id := Name (Ecall_Node); |
1406 | Params_List : constant List_Id := | |
1407 | Parameter_Associations (Ecall_Node); | |
49d882a7 | 1408 | |
1409 | begin | |
1410 | Change_Node (Ecall_Node, N_Procedure_Call_Statement); | |
1411 | Set_Name (Ecall_Node, Fname_Node); | |
1412 | Set_Parameter_Associations (Ecall_Node, Params_List); | |
1413 | end; | |
1414 | ||
1415 | elsif Nkind (Ecall_Node) = N_Identifier | |
1416 | or else Nkind (Ecall_Node) = N_Selected_Component | |
1417 | then | |
3817baeb | 1418 | -- Case of a call to a parameterless entry |
49d882a7 | 1419 | |
1420 | declare | |
1421 | C_Node : constant Node_Id := | |
1422 | New_Node (N_Procedure_Call_Statement, Stmnt_Sloc); | |
1423 | begin | |
1424 | Set_Name (C_Node, Ecall_Node); | |
1425 | Set_Parameter_Associations (C_Node, No_List); | |
1426 | Ecall_Node := C_Node; | |
1427 | end; | |
1428 | end if; | |
1429 | ||
1430 | TF_Semicolon; | |
1431 | ||
1432 | exception | |
1433 | when Error_Resync => | |
1434 | Resync_Past_Semicolon; | |
1435 | return Error; | |
1436 | end; | |
1437 | ||
1438 | Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm); | |
1439 | ||
1440 | -- OR follows, we have a timed entry call | |
1441 | ||
1442 | if Token = Tok_Or then | |
1443 | Scan; -- past OR | |
1444 | Alt_Pragmas := P_Pragmas_Opt; | |
1445 | ||
1446 | Select_Node := New_Node (N_Timed_Entry_Call, Select_Sloc); | |
1447 | Set_Entry_Call_Alternative (Select_Node, | |
1448 | Make_Entry_Call_Alternative (Stmnt_Sloc, | |
1449 | Entry_Call_Statement => Ecall_Node, | |
1450 | Pragmas_Before => Select_Pragmas, | |
1451 | Statements => Statement_List)); | |
1452 | ||
1453 | -- Only possibility is delay alternative. If we have anything | |
1454 | -- else, give message, and treat as conditional entry call. | |
1455 | ||
1456 | if Token /= Tok_Delay then | |
1457 | Error_Msg_SC | |
1458 | ("only allowed alternative in timed entry call is delay!"); | |
1459 | Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq)); | |
1460 | Set_Delay_Alternative (Select_Node, Error); | |
1461 | ||
1462 | else | |
1463 | Set_Delay_Alternative (Select_Node, P_Delay_Alternative); | |
1464 | Set_Pragmas_Before | |
1465 | (Delay_Alternative (Select_Node), Alt_Pragmas); | |
1466 | end if; | |
1467 | ||
1468 | -- ELSE follows, we have a conditional entry call | |
1469 | ||
1470 | elsif Token = Tok_Else then | |
1471 | Scan; -- past ELSE | |
1472 | Select_Node := New_Node (N_Conditional_Entry_Call, Select_Sloc); | |
1473 | ||
1474 | Set_Entry_Call_Alternative (Select_Node, | |
1475 | Make_Entry_Call_Alternative (Stmnt_Sloc, | |
1476 | Entry_Call_Statement => Ecall_Node, | |
1477 | Pragmas_Before => Select_Pragmas, | |
1478 | Statements => Statement_List)); | |
1479 | ||
1480 | Set_Else_Statements | |
1481 | (Select_Node, P_Sequence_Of_Statements (SS_Sreq)); | |
1482 | ||
1483 | -- Only remaining case is THEN ABORT (asynchronous select) | |
1484 | ||
1485 | elsif Token = Tok_Abort then | |
1486 | Select_Node := | |
1487 | Make_Asynchronous_Select (Select_Sloc, | |
1488 | Triggering_Alternative => | |
1489 | Make_Triggering_Alternative (Stmnt_Sloc, | |
1490 | Triggering_Statement => Ecall_Node, | |
1491 | Pragmas_Before => Select_Pragmas, | |
1492 | Statements => Statement_List), | |
1493 | Abortable_Part => P_Abortable_Part); | |
1494 | ||
1495 | -- Else error | |
1496 | ||
1497 | else | |
e2aa7314 | 1498 | if Ada_Version = Ada_83 then |
49d882a7 | 1499 | Error_Msg_BC ("OR or ELSE expected"); |
1500 | else | |
1501 | Error_Msg_BC ("OR or ELSE or THEN ABORT expected"); | |
1502 | end if; | |
1503 | ||
1504 | Select_Node := Error; | |
1505 | end if; | |
1506 | ||
1507 | End_Statements; | |
1508 | ||
27f48659 | 1509 | -- Here we have a selective accept or an asynchronous select (first |
49d882a7 | 1510 | -- token after SELECT is other than a designator token). |
1511 | ||
1512 | else | |
1513 | -- If we have delay with no guard, could be asynchronous select | |
1514 | ||
1515 | if Token = Tok_Delay then | |
1516 | Delay_Stmnt := P_Delay_Statement; | |
1517 | Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm); | |
1518 | ||
1519 | -- Asynchronous select | |
1520 | ||
1521 | if Token = Tok_Abort then | |
1522 | Select_Node := | |
1523 | Make_Asynchronous_Select (Select_Sloc, | |
1524 | Triggering_Alternative => | |
1525 | Make_Triggering_Alternative (Stmnt_Sloc, | |
1526 | Triggering_Statement => Delay_Stmnt, | |
1527 | Pragmas_Before => Select_Pragmas, | |
1528 | Statements => Statement_List), | |
1529 | Abortable_Part => P_Abortable_Part); | |
1530 | ||
1531 | End_Statements; | |
1532 | return Select_Node; | |
1533 | ||
1534 | -- Delay which was not an asynchronous select. Must be a selective | |
1535 | -- accept, and since at least one accept statement is required, | |
1536 | -- we must have at least one OR phrase present. | |
1537 | ||
1538 | else | |
1539 | Alt_List := New_List ( | |
1540 | Make_Delay_Alternative (Stmnt_Sloc, | |
1541 | Delay_Statement => Delay_Stmnt, | |
1542 | Pragmas_Before => Select_Pragmas, | |
1543 | Statements => Statement_List)); | |
1544 | T_Or; | |
1545 | Alt_Pragmas := P_Pragmas_Opt; | |
1546 | end if; | |
1547 | ||
1548 | -- If not a delay statement, then must be another possibility for | |
1549 | -- a selective accept alternative, or perhaps a guard is present | |
1550 | ||
1551 | else | |
1552 | Alt_List := New_List; | |
1553 | Alt_Pragmas := Select_Pragmas; | |
1554 | end if; | |
1555 | ||
1556 | Select_Node := New_Node (N_Selective_Accept, Select_Sloc); | |
1557 | Set_Select_Alternatives (Select_Node, Alt_List); | |
1558 | ||
1559 | -- Scan out selective accept alternatives. On entry to this loop, | |
1560 | -- we are just past a SELECT or OR token, and any pragmas that | |
1561 | -- immediately follow the SELECT or OR are in Alt_Pragmas. | |
1562 | ||
1563 | loop | |
1564 | if Token = Tok_When then | |
1565 | ||
1566 | if Present (Alt_Pragmas) then | |
1567 | Error_Msg_SC ("pragmas may not precede guard"); | |
1568 | end if; | |
1569 | ||
1570 | Scan; -- past WHEN | |
1571 | Cond_Expr := P_Expression_No_Right_Paren; | |
1572 | T_Arrow; | |
1573 | Alt_Pragmas := P_Pragmas_Opt; | |
1574 | ||
1575 | else | |
1576 | Cond_Expr := Empty; | |
1577 | end if; | |
1578 | ||
1579 | if Token = Tok_Accept then | |
1580 | Alternative := P_Accept_Alternative; | |
1581 | ||
1582 | -- Check for junk attempt at asynchronous select using | |
1583 | -- an Accept alternative as the triggering statement | |
1584 | ||
1585 | if Token = Tok_Abort | |
1586 | and then Is_Empty_List (Alt_List) | |
1587 | and then No (Cond_Expr) | |
1588 | then | |
1589 | Error_Msg | |
1590 | ("triggering statement must be entry call or delay", | |
1591 | Sloc (Alternative)); | |
1592 | Scan; -- past junk ABORT | |
1593 | Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq)); | |
1594 | End_Statements; | |
1595 | return Error; | |
1596 | end if; | |
1597 | ||
1598 | elsif Token = Tok_Delay then | |
1599 | Alternative := P_Delay_Alternative; | |
1600 | ||
1601 | elsif Token = Tok_Terminate then | |
1602 | Alternative := P_Terminate_Alternative; | |
1603 | ||
1604 | else | |
1605 | Error_Msg_SC | |
89821a0e | 1606 | ("select alternative (ACCEPT, ABORT, DELAY) expected"); |
49d882a7 | 1607 | Alternative := Error; |
1608 | ||
1609 | if Token = Tok_Semicolon then | |
1610 | Scan; -- past junk semicolon | |
1611 | end if; | |
1612 | end if; | |
1613 | ||
1614 | -- THEN ABORT at this stage is just junk | |
1615 | ||
1616 | if Token = Tok_Abort then | |
1617 | Error_Msg_SP ("misplaced `THEN ABORT`"); | |
1618 | Scan; -- past junk ABORT | |
1619 | Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq)); | |
1620 | End_Statements; | |
1621 | return Error; | |
1622 | ||
1623 | else | |
1624 | if Alternative /= Error then | |
1625 | Set_Condition (Alternative, Cond_Expr); | |
1626 | Set_Pragmas_Before (Alternative, Alt_Pragmas); | |
1627 | Append (Alternative, Alt_List); | |
1628 | end if; | |
1629 | ||
1630 | exit when Token /= Tok_Or; | |
1631 | end if; | |
1632 | ||
1633 | T_Or; | |
1634 | Alt_Pragmas := P_Pragmas_Opt; | |
1635 | end loop; | |
1636 | ||
1637 | if Token = Tok_Else then | |
1638 | Scan; -- past ELSE | |
1639 | Set_Else_Statements | |
1640 | (Select_Node, P_Sequence_Of_Statements (SS_Ortm_Sreq)); | |
1641 | ||
1642 | if Token = Tok_Or then | |
1643 | Error_Msg_SC ("select alternative cannot follow else part!"); | |
1644 | end if; | |
1645 | end if; | |
1646 | ||
1647 | End_Statements; | |
1648 | end if; | |
1649 | ||
1650 | return Select_Node; | |
1651 | end P_Select_Statement; | |
1652 | ||
1653 | ----------------------------- | |
1654 | -- 9.7.1 Selective Accept -- | |
1655 | ----------------------------- | |
1656 | ||
1657 | -- Parsed by P_Select_Statement (9.7) | |
1658 | ||
1659 | ------------------ | |
1660 | -- 9.7.1 Guard -- | |
1661 | ------------------ | |
1662 | ||
1663 | -- Parsed by P_Select_Statement (9.7) | |
1664 | ||
1665 | ------------------------------- | |
1666 | -- 9.7.1 Select Alternative -- | |
1667 | ------------------------------- | |
1668 | ||
1669 | -- SELECT_ALTERNATIVE ::= | |
1670 | -- ACCEPT_ALTERNATIVE | |
1671 | -- | DELAY_ALTERNATIVE | |
1672 | -- | TERMINATE_ALTERNATIVE | |
1673 | ||
1674 | -- Note: the guard preceding a select alternative is included as part | |
1675 | -- of the node generated for a selective accept alternative. | |
1676 | ||
1677 | -- Error recovery: cannot raise Error_Resync | |
1678 | ||
1679 | ------------------------------- | |
1680 | -- 9.7.1 Accept Alternative -- | |
1681 | ------------------------------- | |
1682 | ||
1683 | -- ACCEPT_ALTERNATIVE ::= | |
1684 | -- ACCEPT_STATEMENT [SEQUENCE_OF_STATEMENTS] | |
1685 | ||
1686 | -- Error_Recovery: Cannot raise Error_Resync | |
1687 | ||
1688 | -- Note: the caller is responsible for setting the Pragmas_Before | |
1689 | -- field of the returned N_Terminate_Alternative node. | |
1690 | ||
1691 | function P_Accept_Alternative return Node_Id is | |
1692 | Accept_Alt_Node : Node_Id; | |
1693 | ||
1694 | begin | |
1695 | Accept_Alt_Node := New_Node (N_Accept_Alternative, Token_Ptr); | |
1696 | Set_Accept_Statement (Accept_Alt_Node, P_Accept_Statement); | |
1697 | ||
1698 | -- Note: the reason that we accept THEN ABORT as a terminator for | |
1699 | -- the sequence of statements is for error recovery which allows | |
27f48659 | 1700 | -- for misuse of an accept statement as a triggering statement. |
49d882a7 | 1701 | |
1702 | Set_Statements | |
1703 | (Accept_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm)); | |
1704 | return Accept_Alt_Node; | |
1705 | end P_Accept_Alternative; | |
1706 | ||
1707 | ------------------------------ | |
1708 | -- 9.7.1 Delay Alternative -- | |
1709 | ------------------------------ | |
1710 | ||
1711 | -- DELAY_ALTERNATIVE ::= | |
1712 | -- DELAY_STATEMENT [SEQUENCE_OF_STATEMENTS] | |
1713 | ||
1714 | -- Error_Recovery: Cannot raise Error_Resync | |
1715 | ||
1716 | -- Note: the caller is responsible for setting the Pragmas_Before | |
1717 | -- field of the returned N_Terminate_Alternative node. | |
1718 | ||
1719 | function P_Delay_Alternative return Node_Id is | |
1720 | Delay_Alt_Node : Node_Id; | |
1721 | ||
1722 | begin | |
1723 | Delay_Alt_Node := New_Node (N_Delay_Alternative, Token_Ptr); | |
1724 | Set_Delay_Statement (Delay_Alt_Node, P_Delay_Statement); | |
1725 | ||
1726 | -- Note: the reason that we accept THEN ABORT as a terminator for | |
1727 | -- the sequence of statements is for error recovery which allows | |
27f48659 | 1728 | -- for misuse of an accept statement as a triggering statement. |
49d882a7 | 1729 | |
1730 | Set_Statements | |
1731 | (Delay_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm)); | |
1732 | return Delay_Alt_Node; | |
1733 | end P_Delay_Alternative; | |
1734 | ||
1735 | ---------------------------------- | |
1736 | -- 9.7.1 Terminate Alternative -- | |
1737 | ---------------------------------- | |
1738 | ||
1739 | -- TERMINATE_ALTERNATIVE ::= terminate; | |
1740 | ||
1741 | -- Error_Recovery: Cannot raise Error_Resync | |
1742 | ||
1743 | -- Note: the caller is responsible for setting the Pragmas_Before | |
1744 | -- field of the returned N_Terminate_Alternative node. | |
1745 | ||
1746 | function P_Terminate_Alternative return Node_Id is | |
1747 | Terminate_Alt_Node : Node_Id; | |
1748 | ||
1749 | begin | |
1750 | Terminate_Alt_Node := New_Node (N_Terminate_Alternative, Token_Ptr); | |
1751 | Scan; -- past TERMINATE | |
1752 | TF_Semicolon; | |
1753 | ||
1754 | -- For all other select alternatives, the sequence of statements | |
1755 | -- after the alternative statement will swallow up any pragmas | |
1756 | -- coming in this position. But the terminate alternative has no | |
1757 | -- sequence of statements, so the pragmas here must be treated | |
1758 | -- specially. | |
1759 | ||
1760 | Set_Pragmas_After (Terminate_Alt_Node, P_Pragmas_Opt); | |
1761 | return Terminate_Alt_Node; | |
1762 | end P_Terminate_Alternative; | |
1763 | ||
1764 | ----------------------------- | |
1765 | -- 9.7.2 Timed Entry Call -- | |
1766 | ----------------------------- | |
1767 | ||
1768 | -- Parsed by P_Select_Statement (9.7) | |
1769 | ||
1770 | ----------------------------------- | |
1771 | -- 9.7.2 Entry Call Alternative -- | |
1772 | ----------------------------------- | |
1773 | ||
1774 | -- Parsed by P_Select_Statement (9.7) | |
1775 | ||
1776 | ----------------------------------- | |
1777 | -- 9.7.3 Conditional Entry Call -- | |
1778 | ----------------------------------- | |
1779 | ||
1780 | -- Parsed by P_Select_Statement (9.7) | |
1781 | ||
1782 | -------------------------------- | |
1783 | -- 9.7.4 Asynchronous Select -- | |
1784 | -------------------------------- | |
1785 | ||
1786 | -- Parsed by P_Select_Statement (9.7) | |
1787 | ||
1788 | ----------------------------------- | |
1789 | -- 9.7.4 Triggering Alternative -- | |
1790 | ----------------------------------- | |
1791 | ||
1792 | -- Parsed by P_Select_Statement (9.7) | |
1793 | ||
1794 | --------------------------------- | |
1795 | -- 9.7.4 Triggering Statement -- | |
1796 | --------------------------------- | |
1797 | ||
1798 | -- Parsed by P_Select_Statement (9.7) | |
1799 | ||
1800 | --------------------------- | |
1801 | -- 9.7.4 Abortable Part -- | |
1802 | --------------------------- | |
1803 | ||
1804 | -- ABORTABLE_PART ::= SEQUENCE_OF_STATEMENTS | |
1805 | ||
1806 | -- The caller has verified that THEN ABORT is present, and Token is | |
1807 | -- pointing to the ABORT on entry (or if not, then we have an error) | |
1808 | ||
1809 | -- Error recovery: cannot raise Error_Resync | |
1810 | ||
1811 | function P_Abortable_Part return Node_Id is | |
1812 | Abortable_Part_Node : Node_Id; | |
1813 | ||
1814 | begin | |
1815 | Abortable_Part_Node := New_Node (N_Abortable_Part, Token_Ptr); | |
1816 | T_Abort; -- scan past ABORT | |
1817 | ||
e2aa7314 | 1818 | if Ada_Version = Ada_83 then |
49d882a7 | 1819 | Error_Msg_SP ("(Ada 83) asynchronous select not allowed!"); |
1820 | end if; | |
1821 | ||
1822 | Set_Statements (Abortable_Part_Node, P_Sequence_Of_Statements (SS_Sreq)); | |
1823 | return Abortable_Part_Node; | |
1824 | end P_Abortable_Part; | |
1825 | ||
1826 | -------------------------- | |
1827 | -- 9.8 Abort Statement -- | |
1828 | -------------------------- | |
1829 | ||
1830 | -- ABORT_STATEMENT ::= abort task_NAME {, task_NAME}; | |
1831 | ||
1832 | -- The caller has checked that the initial token is ABORT | |
1833 | ||
1834 | -- Error recovery: cannot raise Error_Resync | |
1835 | ||
1836 | function P_Abort_Statement return Node_Id is | |
1837 | Abort_Node : Node_Id; | |
1838 | ||
1839 | begin | |
1840 | Abort_Node := New_Node (N_Abort_Statement, Token_Ptr); | |
1841 | Scan; -- past ABORT | |
1842 | Set_Names (Abort_Node, New_List); | |
1843 | ||
1844 | loop | |
1845 | Append (P_Name, Names (Abort_Node)); | |
1846 | exit when Token /= Tok_Comma; | |
1847 | Scan; -- past comma | |
1848 | end loop; | |
1849 | ||
1850 | TF_Semicolon; | |
1851 | return Abort_Node; | |
1852 | end P_Abort_Statement; | |
1853 | ||
1854 | end Ch9; |