]>
Commit | Line | Data |
---|---|---|
19235870 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P A R -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
473e20df | 9 | -- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- |
19235870 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
19235870 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
19235870 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
19235870 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
0f1a6a0b | 26 | with Aspects; use Aspects; |
19235870 RK |
27 | with Atree; use Atree; |
28 | with Casing; use Casing; | |
19235870 RK |
29 | with Debug; use Debug; |
30 | with Elists; use Elists; | |
31 | with Errout; use Errout; | |
32 | with Fname; use Fname; | |
33 | with Lib; use Lib; | |
34 | with Namet; use Namet; | |
c228a069 | 35 | with Namet.Sp; use Namet.Sp; |
19235870 RK |
36 | with Nlists; use Nlists; |
37 | with Nmake; use Nmake; | |
38 | with Opt; use Opt; | |
39 | with Output; use Output; | |
6f12117a | 40 | with Par_SCO; use Par_SCO; |
d8b962d8 | 41 | with Restrict; use Restrict; |
19235870 RK |
42 | with Scans; use Scans; |
43 | with Scn; use Scn; | |
23685ae6 | 44 | with Sem_Util; use Sem_Util; |
19235870 RK |
45 | with Sinput; use Sinput; |
46 | with Sinput.L; use Sinput.L; | |
47 | with Sinfo; use Sinfo; | |
48 | with Snames; use Snames; | |
49 | with Style; | |
c75c4293 | 50 | with Stylesw; use Stylesw; |
19235870 | 51 | with Table; |
fbf5a39b | 52 | with Tbuild; use Tbuild; |
19235870 | 53 | |
2820d220 AC |
54 | --------- |
55 | -- Par -- | |
56 | --------- | |
57 | ||
3a336262 | 58 | function Par (Configuration_Pragmas : Boolean) return List_Id is |
6f12117a | 59 | |
19235870 RK |
60 | Num_Library_Units : Natural := 0; |
61 | -- Count number of units parsed (relevant only in syntax check only mode, | |
62 | -- since in semantics check mode only a single unit is permitted anyway) | |
63 | ||
19235870 RK |
64 | Save_Config_Switches : Config_Switches_Type; |
65 | -- Variable used to save values of config switches while we parse the | |
66 | -- new unit, to be restored on exit for proper recursive behavior. | |
67 | ||
68 | Loop_Block_Count : Nat := 0; | |
69 | -- Counter used for constructing loop/block names (see the routine | |
70 | -- Par.Ch5.Get_Loop_Block_Name) | |
71 | ||
72 | -------------------- | |
73 | -- Error Recovery -- | |
74 | -------------------- | |
75 | ||
76 | -- When an error is encountered, a call is made to one of the Error_Msg | |
77 | -- routines to record the error. If the syntax scan is not derailed by the | |
78 | -- error (e.g. a complaint that logical operators are inconsistent in an | |
79 | -- EXPRESSION), then control returns from the Error_Msg call, and the | |
80 | -- parse continues unimpeded. | |
81 | ||
82 | -- If on the other hand, the Error_Msg represents a situation from which | |
83 | -- the parser cannot recover locally, the exception Error_Resync is raised | |
84 | -- immediately after the call to Error_Msg. Handlers for Error_Resync | |
85 | -- are located at strategic points to resynchronize the parse. For example, | |
86 | -- when an error occurs in a statement, the handler skips to the next | |
87 | -- semicolon and continues the scan from there. | |
88 | ||
89 | -- Each parsing procedure contains a note with the heading "Error recovery" | |
90 | -- which shows if it can propagate the Error_Resync exception. In order | |
91 | -- not to propagate the exception, a procedure must either contain its own | |
92 | -- handler for this exception, or it must not call any other routines which | |
93 | -- propagate the exception. | |
94 | ||
95 | -- Note: the arrangement of Error_Resync handlers is such that it should | |
96 | -- never be possible to transfer control through a procedure which made | |
97 | -- an entry in the scope stack, invalidating the contents of the stack. | |
98 | ||
99 | Error_Resync : exception; | |
9de61fcb | 100 | -- Exception raised on error that is not handled locally, see above |
19235870 RK |
101 | |
102 | Last_Resync_Point : Source_Ptr; | |
103 | -- The resynchronization routines in Par.Sync run a risk of getting | |
104 | -- stuck in an infinite loop if they do not skip a token, and the caller | |
105 | -- keeps repeating the same resync call. On the other hand, if they skip | |
106 | -- a token unconditionally, some recovery opportunities are missed. The | |
107 | -- variable Last_Resync_Point records the token location previously set | |
108 | -- by a Resync call, and if a subsequent Resync call occurs at the same | |
109 | -- location, then the Resync routine does guarantee to skip a token. | |
110 | ||
111 | -------------------------------------------- | |
112 | -- Handling Semicolon Used in Place of IS -- | |
113 | -------------------------------------------- | |
114 | ||
115 | -- The following global variables are used in handling the error situation | |
116 | -- of using a semicolon in place of IS in a subprogram declaration as in: | |
117 | ||
118 | -- procedure X (Y : Integer); | |
119 | -- Q : Integer; | |
120 | -- begin | |
121 | -- ... | |
122 | -- end; | |
123 | ||
124 | -- The two contexts in which this can appear are at the outer level, and | |
125 | -- within a declarative region. At the outer level, we know something is | |
126 | -- wrong as soon as we see the Q (or begin, if there are no declarations), | |
127 | -- and we can immediately decide that the semicolon should have been IS. | |
128 | ||
129 | -- The situation in a declarative region is more complex. The declaration | |
130 | -- of Q could belong to the outer region, and we do not know that we have | |
131 | -- an error until we hit the begin. It is still not clear at this point | |
132 | -- from a syntactic point of view that something is wrong, because the | |
133 | -- begin could belong to the enclosing subprogram or package. However, we | |
134 | -- can incorporate a bit of semantic knowledge and note that the body of | |
135 | -- X is missing, so we definitely DO have an error. We diagnose this error | |
136 | -- as semicolon in place of IS on the subprogram line. | |
137 | ||
138 | -- There are two styles for this diagnostic. If the begin immediately | |
139 | -- follows the semicolon, then we can place a flag (IS expected) right | |
140 | -- on the semicolon. Otherwise we do not detect the error until we hit | |
141 | -- the begin which refers back to the line with the semicolon. | |
142 | ||
143 | -- To control the process in the second case, the following global | |
144 | -- variables are set to indicate that we have a subprogram declaration | |
145 | -- whose body is required and has not yet been found. The prefix SIS | |
146 | -- stands for "Subprogram IS" handling. | |
147 | ||
958a816e | 148 | SIS_Entry_Active : Boolean := False; |
19235870 RK |
149 | -- Set True to indicate that an entry is active (i.e. that a subprogram |
150 | -- declaration has been encountered, and no body for this subprogram has | |
151 | -- been encountered). The remaining fields are valid only if this is True. | |
152 | ||
153 | SIS_Labl : Node_Id; | |
154 | -- Subprogram designator | |
155 | ||
156 | SIS_Sloc : Source_Ptr; | |
157 | -- Source location of FUNCTION/PROCEDURE keyword | |
158 | ||
159 | SIS_Ecol : Column_Number; | |
160 | -- Column number of FUNCTION/PROCEDURE keyword | |
161 | ||
162 | SIS_Semicolon_Sloc : Source_Ptr; | |
163 | -- Source location of semicolon at end of subprogram declaration | |
164 | ||
165 | SIS_Declaration_Node : Node_Id; | |
166 | -- Pointer to tree node for subprogram declaration | |
167 | ||
168 | SIS_Missing_Semicolon_Message : Error_Msg_Id; | |
169 | -- Used to save message ID of missing semicolon message (which will be | |
170 | -- modified to missing IS if necessary). Set to No_Error_Msg in the | |
171 | -- normal (non-error) case. | |
172 | ||
173 | -- Five things can happen to an active SIS entry | |
174 | ||
175 | -- 1. If a BEGIN is encountered with an SIS entry active, then we have | |
176 | -- exactly the situation in which we know the body of the subprogram is | |
177 | -- missing. After posting an error message, we change the spec to a body, | |
178 | -- rechaining the declarations that intervened between the spec and BEGIN. | |
179 | ||
180 | -- 2. Another subprogram declaration or body is encountered. In this | |
181 | -- case the entry gets overwritten with the information for the new | |
182 | -- subprogram declaration. We don't catch some nested cases this way, | |
183 | -- but it doesn't seem worth the effort. | |
184 | ||
185 | -- 3. A nested declarative region (e.g. package declaration or package | |
186 | -- body) is encountered. The SIS active indication is reset at the start | |
187 | -- of such a nested region. Again, like case 2, this causes us to miss | |
188 | -- some nested cases, but it doesn't seen worth the effort to stack and | |
189 | -- unstack the SIS information. Maybe we will reconsider this if we ever | |
a99ada67 | 190 | -- get a complaint about a missed case. |
19235870 RK |
191 | |
192 | -- 4. We encounter a valid pragma INTERFACE or IMPORT that effectively | |
193 | -- supplies the missing body. In this case we reset the entry. | |
194 | ||
dec55d76 | 195 | -- 5. We encounter the end of the declarative region without encountering |
19235870 RK |
196 | -- a BEGIN first. In this situation we simply reset the entry. We know |
197 | -- that there is a missing body, but it seems more reasonable to let the | |
198 | -- later semantic checking discover this. | |
199 | ||
bde58e32 AC |
200 | ---------------------------------------------------- |
201 | -- Handling of Reserved Words Used as Identifiers -- | |
202 | ---------------------------------------------------- | |
203 | ||
8aaeba8f RD |
204 | -- Note: throughout the parser, the terms reserved word and keyword are |
205 | -- used interchangeably to refer to the same set of reserved keywords | |
206 | -- (including until, protected, etc). | |
bde58e32 | 207 | |
8aaeba8f RD |
208 | -- If a reserved word is used in place of an identifier, the parser where |
209 | -- possible tries to recover gracefully. In particular, if the keyword is | |
210 | -- clearly spelled using identifier casing, e.g. Until in a source program | |
211 | -- using mixed case identifiers and lower case keywords, then the keyword | |
212 | -- is treated as an identifier if it appears in a place where an identifier | |
213 | -- is required. | |
bde58e32 AC |
214 | |
215 | -- The situation is more complex if the keyword is spelled with normal | |
8aaeba8f RD |
216 | -- keyword casing. In this case, the parser is more reluctant to consider |
217 | -- it to be intended as an identifier, unless it has some further | |
218 | -- confirmation. | |
bde58e32 AC |
219 | |
220 | -- In the case of an identifier appearing in the identifier list of a | |
8aaeba8f RD |
221 | -- declaration, the appearance of a comma or colon right after the keyword |
222 | -- on the same line is taken as confirmation. For an enumeration literal, | |
223 | -- a comma or right paren right after the identifier is also treated as | |
224 | -- adequate confirmation. | |
bde58e32 AC |
225 | |
226 | -- The following type is used in calls to Is_Reserved_Identifier and | |
227 | -- also to P_Defining_Identifier and P_Identifier. The default for all | |
dec55d76 | 228 | -- these functions is that reserved words in reserved word case are not |
bde58e32 AC |
229 | -- considered to be reserved identifiers. The Id_Check value indicates |
230 | -- tokens, which if they appear immediately after the identifier, are | |
231 | -- taken as confirming that the use of an identifier was expected | |
232 | ||
233 | type Id_Check is | |
234 | (None, | |
235 | -- Default, no special token test | |
236 | ||
237 | C_Comma_Right_Paren, | |
238 | -- Consider as identifier if followed by comma or right paren | |
239 | ||
240 | C_Comma_Colon, | |
241 | -- Consider as identifier if followed by comma or colon | |
242 | ||
243 | C_Do, | |
244 | -- Consider as identifier if followed by DO | |
245 | ||
246 | C_Dot, | |
247 | -- Consider as identifier if followed by period | |
248 | ||
249 | C_Greater_Greater, | |
250 | -- Consider as identifier if followed by >> | |
251 | ||
252 | C_In, | |
253 | -- Consider as identifier if followed by IN | |
254 | ||
255 | C_Is, | |
256 | -- Consider as identifier if followed by IS | |
257 | ||
258 | C_Left_Paren_Semicolon, | |
259 | -- Consider as identifier if followed by left paren or semicolon | |
260 | ||
261 | C_Use, | |
262 | -- Consider as identifier if followed by USE | |
263 | ||
264 | C_Vertical_Bar_Arrow); | |
265 | -- Consider as identifier if followed by | or => | |
266 | ||
19235870 RK |
267 | -------------------------------------------- |
268 | -- Handling IS Used in Place of Semicolon -- | |
269 | -------------------------------------------- | |
270 | ||
271 | -- This is a somewhat trickier situation, and we can't catch it in all | |
272 | -- cases, but we do our best to detect common situations resulting from | |
273 | -- a "cut and paste" operation which forgets to change the IS to semicolon. | |
274 | -- Consider the following example: | |
275 | ||
276 | -- package body X is | |
277 | -- procedure A; | |
278 | -- procedure B is | |
279 | -- procedure C; | |
280 | -- ... | |
281 | -- procedure D is | |
282 | -- begin | |
283 | -- ... | |
284 | -- end; | |
285 | -- begin | |
286 | -- ... | |
287 | -- end; | |
288 | ||
289 | -- The trouble is that the section of text from PROCEDURE B through END; | |
dec55d76 | 290 | -- constitutes a valid procedure body, and the danger is that we find out |
19235870 RK |
291 | -- far too late that something is wrong (indeed most compilers will behave |
292 | -- uncomfortably on the above example). | |
293 | ||
294 | -- We have two approaches to helping to control this situation. First we | |
8aaeba8f RD |
295 | -- make every attempt to avoid swallowing the last END; if we can be sure |
296 | -- that some error will result from doing so. In particular, we won't | |
19235870 RK |
297 | -- accept the END; unless it is exactly correct (in particular it must not |
298 | -- have incorrect name tokens), and we won't accept it if it is immediately | |
299 | -- followed by end of file, WITH or SEPARATE (all tokens that unmistakeably | |
300 | -- signal the start of a compilation unit, and which therefore allow us to | |
301 | -- reserve the END; for the outer level.) For more details on this aspect | |
302 | -- of the handling, see package Par.Endh. | |
303 | ||
dec55d76 | 304 | -- If we can avoid eating up the END; then the result in the absence of |
19235870 RK |
305 | -- any additional steps would be to post a missing END referring back to |
306 | -- the subprogram with the bogus IS. Similarly, if the enclosing package | |
307 | -- has no BEGIN, then the result is a missing BEGIN message, which again | |
308 | -- refers back to the subprogram header. | |
309 | ||
310 | -- Such an error message is not too bad (it's already a big improvement | |
311 | -- over what many parsers do), but it's not ideal, because the declarations | |
312 | -- following the IS have been absorbed into the wrong scope. In the above | |
313 | -- case, this could result for example in a bogus complaint that the body | |
314 | -- of D was missing from the package. | |
315 | ||
316 | -- To catch at least some of these cases, we take the following additional | |
317 | -- steps. First, a subprogram body is marked as having a suspicious IS if | |
318 | -- the declaration line is followed by a line which starts with a symbol | |
319 | -- that can start a declaration in the same column, or to the left of the | |
320 | -- column in which the FUNCTION or PROCEDURE starts (normal style is to | |
321 | -- indent any declarations which really belong a subprogram). If such a | |
322 | -- subprogram encounters a missing BEGIN or missing END, then we decide | |
323 | -- that the IS should have been a semicolon, and the subprogram body node | |
324 | -- is marked (by setting the Bad_Is_Detected flag true. Note that we do | |
325 | -- not do this for library level procedures, only for nested procedures, | |
326 | -- since for library level procedures, we must have a body. | |
327 | ||
328 | -- The processing for a declarative part checks to see if the last | |
329 | -- declaration scanned is marked in this way, and if it is, the tree | |
330 | -- is modified to reflect the IS being interpreted as a semicolon. | |
331 | ||
332 | --------------------------------------------------- | |
333 | -- Parser Type Definitions and Control Variables -- | |
334 | --------------------------------------------------- | |
335 | ||
336 | -- The following variable and associated type declaration are used by the | |
337 | -- expression parsing routines to return more detailed information about | |
338 | -- the categorization of a parsed expression. | |
339 | ||
340 | type Expr_Form_Type is ( | |
341 | EF_Simple_Name, -- Simple name, i.e. possibly qualified identifier | |
342 | EF_Name, -- Simple expression which could also be a name | |
343 | EF_Simple, -- Simple expression which is not call or name | |
344 | EF_Range_Attr, -- Range attribute reference | |
345 | EF_Non_Simple); -- Expression that is not a simple expression | |
346 | ||
347 | Expr_Form : Expr_Form_Type; | |
348 | ||
349 | -- The following type is used for calls to P_Subprogram, P_Package, P_Task, | |
350 | -- P_Protected to indicate which of several possibilities is acceptable. | |
351 | ||
352 | type Pf_Rec is record | |
353 | Spcn : Boolean; -- True if specification OK | |
354 | Decl : Boolean; -- True if declaration OK | |
355 | Gins : Boolean; -- True if generic instantiation OK | |
356 | Pbod : Boolean; -- True if proper body OK | |
357 | Rnam : Boolean; -- True if renaming declaration OK | |
358 | Stub : Boolean; -- True if body stub OK | |
308e6f3a | 359 | Pexp : Boolean; -- True if parametrized expression OK |
19235870 RK |
360 | Fil2 : Boolean; -- Filler to fill to 8 bits |
361 | end record; | |
362 | pragma Pack (Pf_Rec); | |
363 | ||
364 | function T return Boolean renames True; | |
365 | function F return Boolean renames False; | |
366 | ||
2e79de51 AC |
367 | Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp : constant Pf_Rec := |
368 | Pf_Rec'(F, T, T, T, T, T, T, F); | |
369 | Pf_Decl_Pexp : constant Pf_Rec := | |
370 | Pf_Rec'(F, T, F, F, F, F, T, F); | |
371 | Pf_Decl_Gins_Pbod_Rnam_Pexp : constant Pf_Rec := | |
372 | Pf_Rec'(F, T, T, T, T, F, T, F); | |
373 | Pf_Decl_Pbod_Pexp : constant Pf_Rec := | |
374 | Pf_Rec'(F, T, F, T, F, F, T, F); | |
375 | Pf_Pbod_Pexp : constant Pf_Rec := | |
376 | Pf_Rec'(F, F, F, T, F, F, T, F); | |
377 | Pf_Spcn : constant Pf_Rec := | |
378 | Pf_Rec'(T, F, F, F, F, F, F, F); | |
19235870 RK |
379 | -- The above are the only allowed values of Pf_Rec arguments |
380 | ||
381 | type SS_Rec is record | |
382 | Eftm : Boolean; -- ELSIF can terminate sequence | |
383 | Eltm : Boolean; -- ELSE can terminate sequence | |
384 | Extm : Boolean; -- EXCEPTION can terminate sequence | |
385 | Ortm : Boolean; -- OR can terminate sequence | |
386 | Sreq : Boolean; -- at least one statement required | |
387 | Tatm : Boolean; -- THEN ABORT can terminate sequence | |
388 | Whtm : Boolean; -- WHEN can terminate sequence | |
389 | Unco : Boolean; -- Unconditional terminate after one statement | |
390 | end record; | |
391 | pragma Pack (SS_Rec); | |
392 | ||
393 | SS_Eftm_Eltm_Sreq : constant SS_Rec := SS_Rec'(T, T, F, F, T, F, F, F); | |
394 | SS_Eltm_Ortm_Tatm : constant SS_Rec := SS_Rec'(F, T, F, T, F, T, F, F); | |
395 | SS_Extm_Sreq : constant SS_Rec := SS_Rec'(F, F, T, F, T, F, F, F); | |
396 | SS_None : constant SS_Rec := SS_Rec'(F, F, F, F, F, F, F, F); | |
397 | SS_Ortm_Sreq : constant SS_Rec := SS_Rec'(F, F, F, T, T, F, F, F); | |
398 | SS_Sreq : constant SS_Rec := SS_Rec'(F, F, F, F, T, F, F, F); | |
399 | SS_Sreq_Whtm : constant SS_Rec := SS_Rec'(F, F, F, F, T, F, T, F); | |
400 | SS_Whtm : constant SS_Rec := SS_Rec'(F, F, F, F, F, F, T, F); | |
401 | SS_Unco : constant SS_Rec := SS_Rec'(F, F, F, F, F, F, F, T); | |
402 | ||
523456db AC |
403 | Goto_List : Elist_Id; |
404 | -- List of goto nodes appearing in the current compilation. Used to | |
405 | -- recognize natural loops and convert them into bona fide loops for | |
406 | -- optimization purposes. | |
407 | ||
19235870 RK |
408 | Label_List : Elist_Id; |
409 | -- List of label nodes for labels appearing in the current compilation. | |
410 | -- Used by Par.Labl to construct the corresponding implicit declarations. | |
411 | ||
412 | ----------------- | |
413 | -- Scope Table -- | |
414 | ----------------- | |
415 | ||
8aaeba8f RD |
416 | -- The scope table, also referred to as the scope stack, is used to record |
417 | -- the current scope context. It is organized as a stack, with inner nested | |
418 | -- entries corresponding to higher entries on the stack. An entry is made | |
419 | -- when the parser encounters the opening of a nested construct (such as a | |
420 | -- record, task, package etc.), and then package Par.Endh uses this stack | |
421 | -- to deal with END lines (including properly dealing with END nesting | |
422 | -- errors). | |
19235870 RK |
423 | |
424 | type SS_End_Type is | |
425 | -- Type of end entry required for this scope. The last two entries are | |
426 | -- used only in the subprogram body case to mark the case of a suspicious | |
427 | -- IS, or a bad IS (i.e. suspicions confirmed by missing BEGIN or END). | |
428 | -- See separate section on dealing with IS used in place of semicolon. | |
429 | -- Note that for many purposes E_Name, E_Suspicious_Is and E_Bad_Is are | |
430 | -- treated the same (E_Suspicious_Is and E_Bad_Is are simply special cases | |
431 | -- of E_Name). They are placed at the end of the enumeration so that a | |
432 | -- test for >= E_Name catches all three cases efficiently. | |
433 | ||
434 | (E_Dummy, -- dummy entry at outer level | |
435 | E_Case, -- END CASE; | |
436 | E_If, -- END IF; | |
437 | E_Loop, -- END LOOP; | |
438 | E_Record, -- END RECORD; | |
88b32fc3 | 439 | E_Return, -- END RETURN; |
19235870 RK |
440 | E_Select, -- END SELECT; |
441 | E_Name, -- END [name]; | |
442 | E_Suspicious_Is, -- END [name]; (case of suspicious IS) | |
443 | E_Bad_Is); -- END [name]; (case of bad IS) | |
444 | ||
445 | -- The following describes a single entry in the scope table | |
446 | ||
447 | type Scope_Table_Entry is record | |
448 | Etyp : SS_End_Type; | |
449 | -- Type of end entry, as per above description | |
450 | ||
451 | Lreq : Boolean; | |
452 | -- A flag indicating whether the label, if present, is required to | |
8aaeba8f RD |
453 | -- appear on the end line. It is referenced only in the case of Etyp is |
454 | -- equal to E_Name or E_Suspicious_Is where the name may or may not be | |
19235870 RK |
455 | -- required (yes for labeled block, no in other cases). Note that for |
456 | -- all cases except begin, the question of whether a label is required | |
457 | -- can be determined from the other fields (for loop, it is required if | |
458 | -- it is present, and for the other constructs it is never required or | |
459 | -- allowed). | |
460 | ||
461 | Ecol : Column_Number; | |
462 | -- Contains the absolute column number (with tabs expanded) of the | |
8aaeba8f RD |
463 | -- expected column of the end assuming normal Ada indentation usage. If |
464 | -- the RM_Column_Check mode is set, this value is used for generating | |
465 | -- error messages about indentation. Otherwise it is used only to | |
466 | -- control heuristic error recovery actions. | |
19235870 RK |
467 | |
468 | Labl : Node_Id; | |
ec09f261 AC |
469 | -- This field is used to provide the name of the construct being parsed |
470 | -- and indirectly its kind. For loops and blocks, the field contains the | |
471 | -- source name or the generated one. For package specifications, bodies, | |
472 | -- subprogram specifications and bodies the field holds the correponding | |
473 | -- program unit name. For task declarations and bodies, protected types | |
474 | -- and bodies, and accept statements the field hold the name of the type | |
475 | -- or operation. For if-statements, case-statements, and selects, the | |
aeae67ed RD |
476 | -- field is initialized to Error. |
477 | ||
478 | -- Note: this is a bit of an odd (mis)use of Error, since there is no | |
479 | -- Error, but we use this value as a place holder to indicate that it | |
480 | -- is an error to have a label on the end line. | |
19235870 | 481 | |
ec09f261 AC |
482 | -- Whenever the field is a name, it is attached to the parent node of |
483 | -- the construct being parsed. Thus the parent node indicates the kind | |
484 | -- of construct whose parse tree is being built. This is used in error | |
485 | -- recovery. | |
486 | ||
19235870 RK |
487 | Decl : List_Id; |
488 | -- Points to the list of declarations (i.e. the declarative part) | |
489 | -- associated with this construct. It is set only in the END [name] | |
490 | -- cases, and is set to No_List for all other cases which do not have a | |
491 | -- declarative unit associated with them. This is used for determining | |
492 | -- the proper location for implicit label declarations. | |
493 | ||
494 | Node : Node_Id; | |
8aaeba8f RD |
495 | -- Empty except in the case of entries for IF and CASE statements, in |
496 | -- which case it contains the N_If_Statement or N_Case_Statement node. | |
497 | -- This is used for setting the End_Span field. | |
19235870 RK |
498 | |
499 | Sloc : Source_Ptr; | |
8aaeba8f RD |
500 | -- Source location of the opening token of the construct. This is used |
501 | -- to refer back to this line in error messages (such as missing or | |
502 | -- incorrect end lines). The Sloc field is not used, and is not set, if | |
503 | -- a label is present (the Labl field provides the text name of the | |
19235870 RK |
504 | -- label in this case, which is fine for error messages). |
505 | ||
506 | S_Is : Source_Ptr; | |
8aaeba8f RD |
507 | -- S_Is is relevant only if Etyp is set to E_Suspicious_Is or E_Bad_Is. |
508 | -- It records the location of the IS that is considered to be | |
509 | -- suspicious. | |
19235870 RK |
510 | |
511 | Junk : Boolean; | |
512 | -- A boolean flag that is set true if the opening entry is the dubious | |
513 | -- result of some prior error, e.g. a record entry where the record | |
514 | -- keyword was missing. It is used to suppress the issuing of a | |
515 | -- corresponding junk complaint about the end line (we do not want | |
516 | -- to complain about a missing end record when there was no record). | |
517 | end record; | |
518 | ||
519 | -- The following declares the scope table itself. The Last field is the | |
520 | -- stack pointer, so that Scope.Table (Scope.Last) is the top entry. The | |
521 | -- oldest entry, at Scope_Stack (0), is a dummy entry with Etyp set to | |
522 | -- E_Dummy, and the other fields undefined. This dummy entry ensures that | |
523 | -- Scope_Stack (Scope_Stack_Ptr).Etyp can always be tested, and that the | |
524 | -- scope stack pointer is always in range. | |
525 | ||
526 | package Scope is new Table.Table ( | |
527 | Table_Component_Type => Scope_Table_Entry, | |
528 | Table_Index_Type => Int, | |
529 | Table_Low_Bound => 0, | |
530 | Table_Initial => 50, | |
531 | Table_Increment => 100, | |
532 | Table_Name => "Scope"); | |
533 | ||
534 | --------------------------------- | |
535 | -- Parsing Routines by Chapter -- | |
536 | --------------------------------- | |
537 | ||
538 | -- Uncommented declarations in this section simply parse the construct | |
539 | -- corresponding to their name, and return an ID value for the Node or | |
540 | -- List that is created. | |
541 | ||
2820d220 AC |
542 | ------------- |
543 | -- Par.Ch2 -- | |
544 | ------------- | |
545 | ||
19235870 | 546 | package Ch2 is |
470cd9e9 RD |
547 | function P_Pragma (Skipping : Boolean := False) return Node_Id; |
548 | -- Scan out a pragma. If Skipping is True, then the caller is skipping | |
549 | -- the pragma in the context of illegal placement (this is used to avoid | |
550 | -- some junk cascaded messages). | |
19235870 | 551 | |
bde58e32 AC |
552 | function P_Identifier (C : Id_Check := None) return Node_Id; |
553 | -- Scans out an identifier. The parameter C determines the treatment | |
554 | -- of reserved identifiers. See declaration of Id_Check for details. | |
555 | ||
19235870 RK |
556 | function P_Pragmas_Opt return List_Id; |
557 | -- This function scans for a sequence of pragmas in other than a | |
558 | -- declaration sequence or statement sequence context. All pragmas | |
559 | -- can appear except pragmas Assert and Debug, which are only allowed | |
560 | -- in a declaration or statement sequence context. | |
561 | ||
562 | procedure P_Pragmas_Misplaced; | |
563 | -- Skips misplaced pragmas with a complaint | |
564 | ||
565 | procedure P_Pragmas_Opt (List : List_Id); | |
566 | -- Parses optional pragmas and appends them to the List | |
567 | end Ch2; | |
568 | ||
2820d220 AC |
569 | ------------- |
570 | -- Par.Ch3 -- | |
571 | ------------- | |
572 | ||
19235870 RK |
573 | package Ch3 is |
574 | Missing_Begin_Msg : Error_Msg_Id; | |
575 | -- This variable is set by a call to P_Declarative_Part. Normally it | |
576 | -- is set to No_Error_Msg, indicating that no special processing is | |
577 | -- required by the caller. The special case arises when a statement | |
578 | -- is found in the sequence of declarations. In this case the Id of | |
579 | -- the message issued ("declaration expected") is preserved in this | |
580 | -- variable, then the caller can change it to an appropriate missing | |
581 | -- begin message if indeed the BEGIN is missing. | |
582 | ||
19235870 RK |
583 | function P_Array_Type_Definition return Node_Id; |
584 | function P_Basic_Declarative_Items return List_Id; | |
585 | function P_Constraint_Opt return Node_Id; | |
586 | function P_Declarative_Part return List_Id; | |
19235870 RK |
587 | function P_Discrete_Choice_List return List_Id; |
588 | function P_Discrete_Range return Node_Id; | |
589 | function P_Discrete_Subtype_Definition return Node_Id; | |
590 | function P_Known_Discriminant_Part_Opt return List_Id; | |
591 | function P_Signed_Integer_Type_Definition return Node_Id; | |
592 | function P_Range return Node_Id; | |
19235870 RK |
593 | function P_Range_Constraint return Node_Id; |
594 | function P_Record_Definition return Node_Id; | |
19235870 RK |
595 | function P_Subtype_Mark return Node_Id; |
596 | function P_Subtype_Mark_Resync return Node_Id; | |
597 | function P_Unknown_Discriminant_Part_Opt return Boolean; | |
598 | ||
7324bf49 AC |
599 | function P_Access_Definition |
600 | (Null_Exclusion_Present : Boolean) return Node_Id; | |
0ab80019 | 601 | -- Ada 2005 (AI-231/AI-254): The caller parses the null-exclusion part |
7324bf49 AC |
602 | -- and indicates if it was present |
603 | ||
604 | function P_Access_Type_Definition | |
605 | (Header_Already_Parsed : Boolean := False) return Node_Id; | |
0ab80019 | 606 | -- Ada 2005 (AI-254): The formal is used to indicate if the caller has |
7324bf49 AC |
607 | -- parsed the null_exclusion part. In this case the caller has also |
608 | -- removed the ACCESS token | |
609 | ||
19235870 | 610 | procedure P_Component_Items (Decls : List_Id); |
8aaeba8f RD |
611 | -- Scan out one or more component items and append them to the given |
612 | -- list. Only scans out more than one declaration in the case where the | |
613 | -- source has a single declaration with multiple defining identifiers. | |
19235870 | 614 | |
bde58e32 AC |
615 | function P_Defining_Identifier (C : Id_Check := None) return Node_Id; |
616 | -- Scan out a defining identifier. The parameter C controls the | |
617 | -- treatment of errors in case a reserved word is scanned. See the | |
618 | -- declaration of this type for details. | |
619 | ||
a9d8907c | 620 | function P_Interface_Type_Definition |
958a816e | 621 | (Abstract_Present : Boolean) return Node_Id; |
88b32fc3 BD |
622 | -- Ada 2005 (AI-251): Parse the interface type definition part. Abstract |
623 | -- Present indicates if the reserved word "abstract" has been previously | |
624 | -- found. It is used to report an error message because interface types | |
958a816e | 625 | -- are by definition abstract tagged. We generate a record_definition |
88b32fc3 | 626 | -- node if the list of interfaces is empty; otherwise we generate a |
a9d8907c JM |
627 | -- derived_type_definition node (the first interface in this list is the |
628 | -- ancestor interface). | |
629 | ||
958a816e VC |
630 | function P_Null_Exclusion |
631 | (Allow_Anonymous_In_95 : Boolean := False) return Boolean; | |
632 | -- Ada 2005 (AI-231): Parse the null-excluding part. A True result | |
633 | -- indicates that the null-excluding part was present. | |
8aaeba8f | 634 | -- |
958a816e VC |
635 | -- Allow_Anonymous_In_95 is True if we are in a context that allows |
636 | -- anonymous access types in Ada 95, in which case "not null" is legal | |
637 | -- if it precedes "access". | |
2820d220 AC |
638 | |
639 | function P_Subtype_Indication | |
640 | (Not_Null_Present : Boolean := False) return Node_Id; | |
0ab80019 | 641 | -- Ada 2005 (AI-231): The flag Not_Null_Present indicates that the |
2820d220 AC |
642 | -- null-excluding part has been scanned out and it was present. |
643 | ||
1629f700 RD |
644 | function P_Range_Or_Subtype_Mark |
645 | (Allow_Simple_Expression : Boolean := False) return Node_Id; | |
646 | -- Scans out a range or subtype mark, and also permits a general simple | |
308e6f3a | 647 | -- expression if Allow_Simple_Expression is set to True. |
1629f700 | 648 | |
19235870 RK |
649 | function Init_Expr_Opt (P : Boolean := False) return Node_Id; |
650 | -- If an initialization expression is present (:= expression), then | |
651 | -- it is scanned out and returned, otherwise Empty is returned if no | |
652 | -- initialization expression is present. This procedure also handles | |
653 | -- certain common error cases cleanly. The parameter P indicates if | |
654 | -- a right paren can follow the expression (default = no right paren | |
655 | -- allowed). | |
656 | ||
657 | procedure Skip_Declaration (S : List_Id); | |
dec55d76 | 658 | -- Used when scanning statements to skip past a misplaced declaration |
19235870 RK |
659 | -- The declaration is scanned out and appended to the given list. |
660 | -- Token is known to be a declaration token (in Token_Class_Declk) | |
661 | -- on entry, so there definition is a declaration to be scanned. | |
662 | ||
2820d220 AC |
663 | function P_Subtype_Indication |
664 | (Subtype_Mark : Node_Id; | |
665 | Not_Null_Present : Boolean := False) return Node_Id; | |
19235870 RK |
666 | -- This version of P_Subtype_Indication is called when the caller has |
667 | -- already scanned out the subtype mark which is passed as a parameter. | |
0ab80019 | 668 | -- Ada 2005 (AI-231): The flag Not_Null_Present indicates that the |
2820d220 | 669 | -- null-excluding part has been scanned out and it was present. |
19235870 RK |
670 | |
671 | function P_Subtype_Mark_Attribute (Type_Node : Node_Id) return Node_Id; | |
672 | -- Parse a subtype mark attribute. The caller has already parsed the | |
673 | -- subtype mark, which is passed in as the argument, and has checked | |
674 | -- that the current token is apostrophe. | |
19235870 RK |
675 | end Ch3; |
676 | ||
2820d220 AC |
677 | ------------- |
678 | -- Par.Ch4 -- | |
679 | ------------- | |
680 | ||
19235870 RK |
681 | package Ch4 is |
682 | function P_Aggregate return Node_Id; | |
683 | function P_Expression return Node_Id; | |
19235870 RK |
684 | function P_Expression_Or_Range_Attribute return Node_Id; |
685 | function P_Function_Name return Node_Id; | |
686 | function P_Name return Node_Id; | |
687 | function P_Qualified_Simple_Name return Node_Id; | |
688 | function P_Qualified_Simple_Name_Resync return Node_Id; | |
689 | function P_Simple_Expression return Node_Id; | |
690 | function P_Simple_Expression_Or_Range_Attribute return Node_Id; | |
691 | ||
19d846a0 RD |
692 | function P_Case_Expression return Node_Id; |
693 | -- Scans out a case expression. Called with Token pointing to the CASE | |
694 | -- keyword, and returns pointing to the terminating right parent, | |
695 | -- semicolon, or comma, but does not consume this terminating token. | |
696 | ||
b46be8a2 | 697 | function P_Conditional_Expression return Node_Id; |
19d846a0 | 698 | -- Scans out a conditional expression. Called with Token pointing to |
b46be8a2 RD |
699 | -- the IF keyword, and returns pointing to the terminating right paren, |
700 | -- semicolon or comma, but does not consume this terminating token. | |
701 | ||
702 | function P_Expression_If_OK return Node_Id; | |
c37cbdc3 AC |
703 | -- Scans out an expression allowing an unparenthesized case expression, |
704 | -- conditional expression, or quantified expression to appear without | |
705 | -- enclosing parentheses. However, if such an expression is not preceded | |
706 | -- by a left paren, and followed by a right paren, an error message will | |
707 | -- be output noting that parenthesization is required. | |
b46be8a2 RD |
708 | |
709 | function P_Expression_No_Right_Paren return Node_Id; | |
710 | -- Scans out an expression in contexts where the expression cannot be | |
711 | -- terminated by a right paren (gives better error recovery if an errant | |
712 | -- right paren is found after the expression). | |
713 | ||
714 | function P_Expression_Or_Range_Attribute_If_OK return Node_Id; | |
715 | -- Scans out an expression or range attribute where a conditional | |
716 | -- expression is permitted to appear without surrounding parentheses. | |
c37cbdc3 AC |
717 | -- However, if such an expression is not preceded by a left paren, and |
718 | -- followed by a right paren, an error message will be output noting | |
719 | -- that parenthesization is required. | |
b46be8a2 RD |
720 | |
721 | function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id; | |
19235870 RK |
722 | -- This routine scans out a qualified expression when the caller has |
723 | -- already scanned out the name and apostrophe of the construct. | |
a961aa79 AC |
724 | |
725 | function P_Quantified_Expression return Node_Id; | |
726 | -- This routine scans out a quantified expression when the caller has | |
727 | -- already scanned out the keyword "for" of the construct. | |
19235870 RK |
728 | end Ch4; |
729 | ||
2820d220 AC |
730 | ------------- |
731 | -- Par.Ch5 -- | |
732 | ------------- | |
19235870 | 733 | |
2820d220 | 734 | package Ch5 is |
cd9909a0 AC |
735 | function P_Condition return Node_Id; |
736 | -- Scan out and return a condition | |
737 | ||
a961aa79 AC |
738 | function P_Loop_Parameter_Specification return Node_Id; |
739 | -- Used in loop constructs and quantified expressions. | |
740 | ||
19235870 RK |
741 | function P_Sequence_Of_Statements (SS_Flags : SS_Rec) return List_Id; |
742 | -- The argument indicates the acceptable termination tokens. | |
743 | -- See body in Par.Ch5 for details of the use of this parameter. | |
744 | ||
745 | procedure Parse_Decls_Begin_End (Parent : Node_Id); | |
746 | -- Parses declarations and handled statement sequence, setting | |
747 | -- fields of Parent node appropriately. | |
19235870 RK |
748 | end Ch5; |
749 | ||
2820d220 AC |
750 | ------------- |
751 | -- Par.Ch6 -- | |
752 | ------------- | |
753 | ||
19235870 RK |
754 | package Ch6 is |
755 | function P_Designator return Node_Id; | |
756 | function P_Defining_Program_Unit_Name return Node_Id; | |
757 | function P_Formal_Part return List_Id; | |
758 | function P_Parameter_Profile return List_Id; | |
759 | function P_Return_Statement return Node_Id; | |
760 | function P_Subprogram_Specification return Node_Id; | |
761 | ||
762 | procedure P_Mode (Node : Node_Id); | |
8aaeba8f RD |
763 | -- Sets In_Present and/or Out_Present flags in Node scanning past IN, |
764 | -- OUT or IN OUT tokens in the source. | |
19235870 RK |
765 | |
766 | function P_Subprogram (Pf_Flags : Pf_Rec) return Node_Id; | |
767 | -- Scans out any construct starting with either of the keywords | |
768 | -- PROCEDURE or FUNCTION. The parameter indicates which possible | |
769 | -- possible kinds of construct (body, spec, instantiation etc.) | |
770 | -- are permissible in the current context. | |
19235870 RK |
771 | end Ch6; |
772 | ||
2820d220 AC |
773 | ------------- |
774 | -- Par.Ch7 -- | |
775 | ------------- | |
776 | ||
19235870 | 777 | package Ch7 is |
1c54829e | 778 | function P_Package (Pf_Flags : Pf_Rec) return Node_Id; |
19235870 RK |
779 | -- Scans out any construct starting with the keyword PACKAGE. The |
780 | -- parameter indicates which possible kinds of construct (body, spec, | |
1c54829e | 781 | -- instantiation etc.) are permissible in the current context. |
19235870 RK |
782 | end Ch7; |
783 | ||
2820d220 AC |
784 | ------------- |
785 | -- Par.Ch8 -- | |
786 | ------------- | |
787 | ||
19235870 RK |
788 | package Ch8 is |
789 | function P_Use_Clause return Node_Id; | |
790 | end Ch8; | |
791 | ||
2820d220 AC |
792 | ------------- |
793 | -- Par.Ch9 -- | |
794 | ------------- | |
795 | ||
19235870 RK |
796 | package Ch9 is |
797 | function P_Abort_Statement return Node_Id; | |
798 | function P_Abortable_Part return Node_Id; | |
799 | function P_Accept_Statement return Node_Id; | |
800 | function P_Delay_Statement return Node_Id; | |
801 | function P_Entry_Body return Node_Id; | |
802 | function P_Protected return Node_Id; | |
803 | function P_Requeue_Statement return Node_Id; | |
804 | function P_Select_Statement return Node_Id; | |
805 | function P_Task return Node_Id; | |
806 | function P_Terminate_Alternative return Node_Id; | |
807 | end Ch9; | |
808 | ||
2820d220 AC |
809 | -------------- |
810 | -- Par.Ch10 -- | |
811 | -------------- | |
812 | ||
19235870 RK |
813 | package Ch10 is |
814 | function P_Compilation_Unit return Node_Id; | |
8aaeba8f RD |
815 | -- Note: this function scans a single compilation unit, and checks that |
816 | -- an end of file follows this unit, diagnosing any unexpected input as | |
817 | -- an error, and then skipping it, so that Token is set to Tok_EOF on | |
818 | -- return. An exception is in syntax-only mode, where multiple | |
819 | -- compilation units are permitted. In this case, P_Compilation_Unit | |
820 | -- does not check for end of file and there may be more compilation | |
821 | -- units to scan. The caller can uniquely detect this situation by the | |
19235870 | 822 | -- fact that Token is not set to Tok_EOF on return. |
2820d220 | 823 | -- |
8aaeba8f RD |
824 | -- What about multiple unit/file capability that now exists??? |
825 | -- | |
826 | -- The Ignore parameter is normally set False. It is set True in the | |
827 | -- multiple unit per file mode if we are skipping past a unit that we | |
828 | -- are not interested in. | |
19235870 RK |
829 | end Ch10; |
830 | ||
2820d220 AC |
831 | -------------- |
832 | -- Par.Ch11 -- | |
833 | -------------- | |
834 | ||
19235870 RK |
835 | package Ch11 is |
836 | function P_Handled_Sequence_Of_Statements return Node_Id; | |
837 | function P_Raise_Statement return Node_Id; | |
838 | ||
839 | function Parse_Exception_Handlers return List_Id; | |
840 | -- Parses the partial construct EXCEPTION followed by a list of | |
8aaeba8f RD |
841 | -- exception handlers which appears in a number of productions, and |
842 | -- returns the list of exception handlers. | |
19235870 RK |
843 | end Ch11; |
844 | ||
2820d220 AC |
845 | -------------- |
846 | -- Par.Ch12 -- | |
847 | -------------- | |
848 | ||
19235870 RK |
849 | package Ch12 is |
850 | function P_Generic return Node_Id; | |
851 | function P_Generic_Actual_Part_Opt return List_Id; | |
852 | end Ch12; | |
853 | ||
2820d220 AC |
854 | -------------- |
855 | -- Par.Ch13 -- | |
856 | -------------- | |
857 | ||
19235870 RK |
858 | package Ch13 is |
859 | function P_Representation_Clause return Node_Id; | |
860 | ||
39231404 AC |
861 | function Aspect_Specifications_Present |
862 | (Strict : Boolean := Ada_Version < Ada_2012) return Boolean; | |
0f1a6a0b AC |
863 | -- This function tests whether the next keyword is WITH followed by |
864 | -- something that looks reasonably like an aspect specification. If so, | |
865 | -- True is returned. Otherwise False is returned. In either case control | |
866 | -- returns with the token pointer unchanged (i.e. pointing to the WITH | |
867 | -- token in the case where True is returned). This function takes care | |
868 | -- of generating appropriate messages if aspect specifications appear | |
39231404 AC |
869 | -- in versions of Ada prior to Ada 2012. The parameter strict can be |
870 | -- set to True, to be rather strict about considering something to be | |
308e6f3a | 871 | -- an aspect specification. If Strict is False, then the circuitry is |
39231404 | 872 | -- rather more generous in considering something ill-formed to be an |
308e6f3a | 873 | -- attempt at an aspect specification. The default is more strict for |
39231404 | 874 | -- Ada versions before Ada 2012 (where aspect specifications are not |
1c54829e | 875 | -- permitted). Note: this routine never checks the terminator token |
78efd712 AC |
876 | -- for aspects so it does not matter whether the aspect specifications |
877 | -- are terminated by semicolon or some other character. | |
1c54829e | 878 | |
473e20df AC |
879 | function Get_Aspect_Specifications |
880 | (Semicolon : Boolean := True) return List_Id; | |
881 | -- Parse a list of aspects but do not attach them to a declaration node. | |
882 | -- Subsidiary to the following procedure. Used when parsing a subprogram | |
883 | -- specification that may be a declaration or a body. | |
884 | ||
1c54829e AC |
885 | procedure P_Aspect_Specifications |
886 | (Decl : Node_Id; | |
887 | Semicolon : Boolean := True); | |
888 | -- This procedure scans out a series of aspect spefications. If argument | |
889 | -- Semicolon is True, a terminating semicolon is also scanned. If this | |
890 | -- argument is False, the scan pointer is left pointing past the aspects | |
891 | -- and the caller must check for a proper terminator. | |
1c54829e | 892 | -- |
1c163178 | 893 | -- P_Aspect_Specifications is called with the current token pointing to |
1c54829e AC |
894 | -- either a WITH keyword starting an aspect specification, or an |
895 | -- instance of the terminator token. In the former case, the aspect | |
896 | -- specifications are scanned out including the terminator token if it | |
897 | -- it is a semicolon, and the Has_Aspect_Specifications flag is set in | |
898 | -- the given declaration node. A list of aspects is built and stored for | |
899 | -- this declaration node using a call to Set_Aspect_Specifications. If | |
900 | -- no WITH keyword is present, then this call has no effect other than | |
9f90d123 AC |
901 | -- scanning out the terminator if it is a semicolon. |
902 | ||
903 | -- If Decl is Error on entry, any scanned aspect specifications are | |
904 | -- ignored and a message is output saying aspect specifications not | |
905 | -- permitted here. If Decl is Empty, then scanned aspect specifications | |
906 | -- are also ignored, but no error message is given (this is used when | |
907 | -- the caller has already taken care of the error message). | |
0f1a6a0b | 908 | |
19235870 RK |
909 | function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id; |
910 | -- Function to parse a code statement. The caller has scanned out | |
911 | -- the name to be used as the subtype mark (but has not checked that | |
912 | -- it is suitable for use as a subtype mark, i.e. is either an | |
913 | -- identifier or a selected component). The current token is an | |
914 | -- apostrophe and the following token is either a left paren or | |
915 | -- RANGE (the latter being an error to be caught by P_Code_Statement. | |
916 | end Ch13; | |
917 | ||
918 | -- Note: the parsing for annexe J features (i.e. obsolescent features) | |
919 | -- is found in the logical section where these features would be if | |
920 | -- they were not obsolescent. In particular: | |
921 | ||
922 | -- Delta constraint is parsed by P_Delta_Constraint (3.5.9) | |
923 | -- At clause is parsed by P_At_Clause (13.1) | |
924 | -- Mod clause is parsed by P_Mod_Clause (13.5.1) | |
925 | ||
2820d220 AC |
926 | -------------- |
927 | -- Par.Endh -- | |
928 | -------------- | |
19235870 RK |
929 | |
930 | -- Routines for handling end lines, including scope recovery | |
931 | ||
932 | package Endh is | |
9f90d123 AC |
933 | function Check_End |
934 | (Decl : Node_Id := Empty; | |
935 | Is_Loc : Source_Ptr := No_Location) return Boolean; | |
19235870 RK |
936 | -- Called when an end sequence is required. In the absence of an error |
937 | -- situation, Token contains Tok_End on entry, but in a missing end | |
938 | -- case, this may not be the case. Pop_End_Context is used to determine | |
939 | -- the appropriate action to be taken. The returned result is True if | |
940 | -- an End sequence was encountered and False if no End sequence was | |
941 | -- present. This occurs if the END keyword encountered was determined | |
942 | -- to be improper and deleted (i.e. Pop_End_Context set End_Action to | |
943 | -- Skip_And_Reject). Note that the END sequence includes a semicolon, | |
944 | -- except in the case of END RECORD, where a semicolon follows the END | |
945 | -- RECORD, but is not part of the record type definition itself. | |
718deaf1 AC |
946 | -- |
947 | -- If Decl is non-empty, then aspect specifications are permitted | |
948 | -- following the end, and Decl is the declaration node with which | |
9f90d123 AC |
949 | -- these aspect specifications are to be associated. If Decl is empty, |
950 | -- then aspect specifications are not permitted and will generate an | |
951 | -- error message. | |
952 | -- | |
953 | -- Is_Loc is set to other than the default only for the case of a | |
954 | -- package declaration. It points to the IS keyword of the declaration, | |
955 | -- and is used to specialize the error messages for misplaced aspect | |
956 | -- specifications in this case. Note that Decl is always Empty if Is_Loc | |
957 | -- is set. | |
19235870 RK |
958 | |
959 | procedure End_Skip; | |
960 | -- Skip past an end sequence. On entry Token contains Tok_End, and we | |
961 | -- we know that the end sequence is syntactically incorrect, and that | |
962 | -- an appropriate error message has already been posted. The mission | |
963 | -- is simply to position the scan pointer to be the best guess of the | |
964 | -- position after the end sequence. We do not issue any additional | |
965 | -- error messages while carrying this out. | |
966 | ||
718deaf1 | 967 | procedure End_Statements |
9f90d123 AC |
968 | (Parent : Node_Id := Empty; |
969 | Decl : Node_Id := Empty; | |
970 | Is_Sloc : Source_Ptr := No_Location); | |
19235870 RK |
971 | -- Called when an end is required or expected to terminate a sequence |
972 | -- of statements. The caller has already made an appropriate entry in | |
973 | -- the Scope.Table to describe the expected form of the end. This can | |
974 | -- only be used in cases where the only appropriate terminator is end. | |
975 | -- If Parent is non-empty, then if a correct END line is encountered, | |
976 | -- the End_Label field of Parent is set appropriately. | |
718deaf1 AC |
977 | -- |
978 | -- If Decl is non-null, then it is a declaration node, and aspect | |
979 | -- specifications are permitted after the end statement. These aspect | |
980 | -- specifications, if present, are stored in this declaration node. | |
9f90d123 AC |
981 | -- If Decl is null, then aspect specifications are not permitted after |
982 | -- the end statement. | |
983 | -- | |
984 | -- In the case where Decl is null, Is_Sloc determines the handling. If | |
985 | -- it is set to No_Location, then aspect specifications are ignored and | |
986 | -- an error message is given. Is_Sloc is used in the package declaration | |
987 | -- case to point to the IS, and is used to specialize the error emssages | |
988 | -- issued in this case. | |
19235870 RK |
989 | end Endh; |
990 | ||
2820d220 AC |
991 | -------------- |
992 | -- Par.Sync -- | |
993 | -------------- | |
19235870 RK |
994 | |
995 | -- These procedures are used to resynchronize after errors. Following an | |
996 | -- error which is not immediately locally recoverable, the exception | |
997 | -- Error_Resync is raised. The handler for Error_Resync typically calls | |
998 | -- one of these recovery procedures to resynchronize the source position | |
999 | -- to a point from which parsing can be restarted. | |
1000 | ||
1001 | -- Note: these procedures output an information message that tokens are | |
1002 | -- being skipped, but this message is output only if the option for | |
1003 | -- Multiple_Errors_Per_Line is set in Options. | |
1004 | ||
1005 | package Sync is | |
19235870 RK |
1006 | procedure Resync_Choice; |
1007 | -- Used if an error occurs scanning a choice. The scan pointer is | |
1008 | -- advanced to the next vertical bar, arrow, or semicolon, whichever | |
1009 | -- comes first. We also quit if we encounter an end of file. | |
1010 | ||
1011 | procedure Resync_Expression; | |
1012 | -- Used if an error is detected during the parsing of an expression. | |
1013 | -- It skips past tokens until either a token which cannot be part of | |
1014 | -- an expression is encountered (an expression terminator), or if a | |
1015 | -- comma or right parenthesis or vertical bar is encountered at the | |
1016 | -- current parenthesis level (a parenthesis level counter is maintained | |
1017 | -- to carry out this test). | |
1018 | ||
1019 | procedure Resync_Past_Semicolon; | |
1020 | -- Used if an error occurs while scanning a sequence of declarations. | |
1021 | -- The scan pointer is positioned past the next semicolon and the scan | |
1022 | -- resumes. The scan is also resumed on encountering a token which | |
1023 | -- starts a declaration (but we make sure to skip at least one token | |
1024 | -- in this case, to avoid getting stuck in a loop). | |
1025 | ||
fbf5a39b AC |
1026 | procedure Resync_To_Semicolon; |
1027 | -- Similar to Resync_Past_Semicolon, except that the scan pointer is | |
1028 | -- left pointing to the semicolon rather than past it. | |
1029 | ||
19235870 | 1030 | procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then; |
8aaeba8f RD |
1031 | -- Used if an error occurs while scanning a sequence of statements. The |
1032 | -- scan pointer is positioned past the next semicolon, or to the next | |
1033 | -- occurrence of either then or loop, and the scan resumes. | |
19235870 RK |
1034 | |
1035 | procedure Resync_To_When; | |
8aaeba8f RD |
1036 | -- Used when an error occurs scanning an entry index specification. The |
1037 | -- scan pointer is positioned to the next WHEN (or to IS or semicolon if | |
1038 | -- either of these appear before WHEN, indicating another error has | |
1039 | -- occurred). | |
19235870 RK |
1040 | |
1041 | procedure Resync_Semicolon_List; | |
1042 | -- Used if an error occurs while scanning a parenthesized list of items | |
1043 | -- separated by semicolons. The scan pointer is advanced to the next | |
1044 | -- semicolon or right parenthesis at the outer parenthesis level, or | |
dec55d76 | 1045 | -- to the next is or RETURN keyword occurrence, whichever comes first. |
19235870 RK |
1046 | |
1047 | procedure Resync_Cunit; | |
1048 | -- Synchronize to next token which could be the start of a compilation | |
1049 | -- unit, or to the end of file token. | |
19235870 RK |
1050 | end Sync; |
1051 | ||
2820d220 AC |
1052 | -------------- |
1053 | -- Par.Tchk -- | |
1054 | -------------- | |
19235870 RK |
1055 | |
1056 | -- Routines to check for expected tokens | |
1057 | ||
1058 | package Tchk is | |
1059 | ||
1060 | -- Procedures with names of the form T_xxx, where Tok_xxx is a token | |
1061 | -- name, check that the current token matches the required token, and | |
1062 | -- if so, scan past it. If not, an error is issued indicating that | |
1063 | -- the required token is not present (xxx expected). In most cases, the | |
1064 | -- scan pointer is not moved in the not-found case, but there are some | |
1065 | -- exceptions to this, see for example T_Id, where the scan pointer is | |
1066 | -- moved across a literal appearing where an identifier is expected. | |
1067 | ||
1068 | procedure T_Abort; | |
1069 | procedure T_Arrow; | |
1070 | procedure T_At; | |
1071 | procedure T_Body; | |
1072 | procedure T_Box; | |
1073 | procedure T_Colon; | |
1074 | procedure T_Colon_Equal; | |
1075 | procedure T_Comma; | |
1076 | procedure T_Dot_Dot; | |
1077 | procedure T_For; | |
1078 | procedure T_Greater_Greater; | |
1079 | procedure T_Identifier; | |
1080 | procedure T_In; | |
1081 | procedure T_Is; | |
1082 | procedure T_Left_Paren; | |
1083 | procedure T_Loop; | |
1084 | procedure T_Mod; | |
1085 | procedure T_New; | |
1086 | procedure T_Of; | |
1087 | procedure T_Or; | |
1088 | procedure T_Private; | |
1089 | procedure T_Range; | |
1090 | procedure T_Record; | |
1091 | procedure T_Right_Paren; | |
1092 | procedure T_Semicolon; | |
1093 | procedure T_Then; | |
1094 | procedure T_Type; | |
1095 | procedure T_Use; | |
1096 | procedure T_When; | |
1097 | procedure T_With; | |
1098 | ||
470cd9e9 | 1099 | -- Procedures having names of the form TF_xxx, where Tok_xxx is a token |
19235870 RK |
1100 | -- name check that the current token matches the required token, and |
1101 | -- if so, scan past it. If not, an error message is issued indicating | |
1102 | -- that the required token is not present (xxx expected). | |
1103 | ||
1104 | -- If the missing token is at the end of the line, then control returns | |
1105 | -- immediately after posting the message. If there are remaining tokens | |
1106 | -- on the current line, a search is conducted to see if the token | |
1107 | -- appears later on the current line, as follows: | |
1108 | ||
1109 | -- A call to Scan_Save is issued and a forward search for the token | |
1110 | -- is carried out. If the token is found on the current line before a | |
1111 | -- semicolon, then it is scanned out and the scan continues from that | |
1112 | -- point. If not the scan is restored to the point where it was missing. | |
1113 | ||
1114 | procedure TF_Arrow; | |
1115 | procedure TF_Is; | |
1116 | procedure TF_Loop; | |
1117 | procedure TF_Return; | |
1118 | procedure TF_Semicolon; | |
1119 | procedure TF_Then; | |
1120 | procedure TF_Use; | |
470cd9e9 RD |
1121 | |
1122 | -- Procedures with names of the form U_xxx, where Tok_xxx is a token | |
1123 | -- name, are just like the corresponding T_xxx procedures except that | |
1124 | -- an error message, if given, is unconditional. | |
1125 | ||
1126 | procedure U_Left_Paren; | |
1127 | procedure U_Right_Paren; | |
19235870 RK |
1128 | end Tchk; |
1129 | ||
2820d220 AC |
1130 | -------------- |
1131 | -- Par.Util -- | |
1132 | -------------- | |
19235870 RK |
1133 | |
1134 | package Util is | |
19235870 RK |
1135 | function Bad_Spelling_Of (T : Token_Type) return Boolean; |
1136 | -- This function is called in an error situation. It checks if the | |
1137 | -- current token is an identifier whose name is a plausible bad | |
1138 | -- spelling of the given keyword token, and if so, issues an error | |
1139 | -- message, sets Token from T, and returns True. Otherwise Token is | |
1140 | -- unchanged, and False is returned. | |
1141 | ||
1142 | procedure Check_Bad_Layout; | |
1143 | -- Check for bad indentation in RM checking mode. Used for statements | |
1144 | -- and declarations. Checks if current token is at start of line and | |
1145 | -- is exdented from the current expected end column, and if so an | |
1146 | -- error message is generated. | |
1147 | ||
1148 | procedure Check_Misspelling_Of (T : Token_Type); | |
1149 | pragma Inline (Check_Misspelling_Of); | |
1150 | -- This is similar to the function above, except that it does not | |
1151 | -- return a result. It is typically used in a situation where any | |
1152 | -- identifier is an error, and it makes sense to simply convert it | |
1153 | -- to the given token if it is a plausible misspelling of it. | |
1154 | ||
1155 | procedure Check_95_Keyword (Token_95, Next : Token_Type); | |
1156 | -- This routine checks if the token after the current one matches the | |
1157 | -- Next argument. If so, the scan is backed up to the current token | |
1158 | -- and Token_Type is changed to Token_95 after issuing an appropriate | |
1159 | -- error message ("(Ada 83) keyword xx cannot be used"). If not, | |
1160 | -- the scan is backed up with Token_Type unchanged. This routine | |
1161 | -- is used to deal with an attempt to use a 95 keyword in Ada 83 | |
1162 | -- mode. The caller has typically checked that the current token, | |
1163 | -- an identifier, matches one of the 95 keywords. | |
1164 | ||
e192a2cd AC |
1165 | procedure Check_Future_Keyword; |
1166 | -- Emit a warning if the current token is a valid identifier in the | |
1167 | -- language version in use, but is a reserved word in a later language | |
1168 | -- version (unless the language version in use is Ada 83). | |
1169 | ||
19235870 RK |
1170 | procedure Check_Simple_Expression (E : Node_Id); |
1171 | -- Given an expression E, that has just been scanned, so that Expr_Form | |
1172 | -- is still set, outputs an error if E is a non-simple expression. E is | |
1173 | -- not modified by this call. | |
1174 | ||
1175 | procedure Check_Simple_Expression_In_Ada_83 (E : Node_Id); | |
1176 | -- Like Check_Simple_Expression, except that the error message is only | |
1177 | -- given when operating in Ada 83 mode, and includes "in Ada 83". | |
1178 | ||
1179 | function Check_Subtype_Mark (Mark : Node_Id) return Node_Id; | |
1180 | -- Called to check that a node representing a name (or call) is | |
1181 | -- suitable for a subtype mark, i.e, that it is an identifier or | |
1182 | -- a selected component. If so, or if it is already Error, then | |
1183 | -- it is returned unchanged. Otherwise an error message is issued | |
1184 | -- and Error is returned. | |
1185 | ||
1186 | function Comma_Present return Boolean; | |
1187 | -- Used in comma delimited lists to determine if a comma is present, or | |
1188 | -- can reasonably be assumed to have been present (an error message is | |
1189 | -- generated in the latter case). If True is returned, the scan has been | |
1190 | -- positioned past the comma. If False is returned, the scan position | |
1191 | -- is unchanged. Note that all comma-delimited lists are terminated by | |
1192 | -- a right paren, so the only legitimate tokens when Comma_Present is | |
1193 | -- called are right paren and comma. If some other token is found, then | |
1194 | -- Comma_Present has the job of deciding whether it is better to pretend | |
1195 | -- a comma was present, post a message for a missing comma and return | |
1196 | -- True, or return False and let the caller diagnose the missing right | |
1197 | -- parenthesis. | |
1198 | ||
1199 | procedure Discard_Junk_Node (N : Node_Id); | |
1200 | procedure Discard_Junk_List (L : List_Id); | |
1201 | pragma Inline (Discard_Junk_Node); | |
1202 | pragma Inline (Discard_Junk_List); | |
1203 | -- These procedures do nothing at all, their effect is simply to discard | |
1204 | -- the argument. A typical use is to skip by some junk that is not | |
1205 | -- expected in the current context. | |
1206 | ||
1207 | procedure Ignore (T : Token_Type); | |
1208 | -- If current token matches T, then give an error message and skip | |
1209 | -- past it, otherwise the call has no effect at all. T may be any | |
1210 | -- reserved word token, or comma, left or right paren, or semicolon. | |
1211 | ||
bde58e32 | 1212 | function Is_Reserved_Identifier (C : Id_Check := None) return Boolean; |
19235870 RK |
1213 | -- Test if current token is a reserved identifier. This test is based |
1214 | -- on the token being a keyword and being spelled in typical identifier | |
bde58e32 AC |
1215 | -- style (i.e. starting with an upper case letter). The parameter C |
1216 | -- determines the special treatment if a reserved word is encountered | |
1217 | -- that has the normal casing of a reserved word. | |
19235870 RK |
1218 | |
1219 | procedure Merge_Identifier (Prev : Node_Id; Nxt : Token_Type); | |
1220 | -- Called when the previous token is an identifier (whose Token_Node | |
1221 | -- value is given by Prev) to check if current token is an identifier | |
1222 | -- that can be merged with the previous one adding an underscore. The | |
1223 | -- merge is only attempted if the following token matches Nxt. If all | |
1224 | -- conditions are met, an error message is issued, and the merge is | |
1225 | -- carried out, modifying the Chars field of Prev. | |
1226 | ||
470cd9e9 RD |
1227 | function Next_Token_Is (Tok : Token_Type) return Boolean; |
1228 | -- Looks at token after current one and returns True if the token type | |
1229 | -- matches Tok. The scan is unconditionally restored on return. | |
1230 | ||
19235870 RK |
1231 | procedure No_Constraint; |
1232 | -- Called in a place where no constraint is allowed, but one might | |
1233 | -- appear due to a common error (e.g. after the type mark in a procedure | |
1234 | -- parameter. If a constraint is present, an error message is posted, | |
1235 | -- and the constraint is scanned and discarded. | |
1236 | ||
19235870 RK |
1237 | procedure Push_Scope_Stack; |
1238 | pragma Inline (Push_Scope_Stack); | |
1239 | -- Push a new entry onto the scope stack. Scope.Last (the stack pointer) | |
1240 | -- is incremented. The Junk field is preinitialized to False. The caller | |
16b05213 | 1241 | -- is expected to fill in all remaining entries of the new top stack |
19235870 RK |
1242 | -- entry at Scope.Table (Scope.Last). |
1243 | ||
1244 | procedure Pop_Scope_Stack; | |
1245 | -- Pop an entry off the top of the scope stack. Scope_Last (the scope | |
1246 | -- table stack pointer) is decremented by one. It is a fatal error to | |
1247 | -- try to pop off the dummy entry at the bottom of the stack (i.e. | |
1248 | -- Scope.Last must be non-zero at the time of call). | |
1249 | ||
1250 | function Separate_Present return Boolean; | |
1251 | -- Determines if the current token is either Tok_Separate, or an | |
1252 | -- identifier that is a possible misspelling of "separate" followed | |
1253 | -- by a semicolon. True is returned if so, otherwise False. | |
1254 | ||
1255 | procedure Signal_Bad_Attribute; | |
1256 | -- The current token is an identifier that is supposed to be an | |
1257 | -- attribute identifier but is not. This routine posts appropriate | |
1258 | -- error messages, including a check for a near misspelling. | |
1259 | ||
1260 | function Token_Is_At_Start_Of_Line return Boolean; | |
1261 | pragma Inline (Token_Is_At_Start_Of_Line); | |
1262 | -- Determines if the current token is the first token on the line | |
1263 | ||
fbf5a39b AC |
1264 | function Token_Is_At_End_Of_Line return Boolean; |
1265 | -- Determines if the current token is the last token on the line | |
b46be8a2 | 1266 | |
19235870 RK |
1267 | end Util; |
1268 | ||
2820d220 AC |
1269 | -------------- |
1270 | -- Par.Prag -- | |
1271 | -------------- | |
1272 | ||
1273 | -- The processing for pragmas is split off from chapter 2 | |
19235870 RK |
1274 | |
1275 | function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id; | |
1276 | -- This function is passed a tree for a pragma that has been scanned out. | |
1277 | -- The pragma is syntactically well formed according to the general syntax | |
1278 | -- for pragmas and the pragma identifier is for one of the recognized | |
1279 | -- pragmas. It performs specific syntactic checks for specific pragmas. | |
1280 | -- The result is the input node if it is OK, or Error otherwise. The | |
1281 | -- reason that this is separated out is to facilitate the addition | |
1282 | -- of implementation defined pragmas. The second parameter records the | |
1283 | -- location of the semicolon following the pragma (this is needed for | |
1284 | -- correct processing of the List and Page pragmas). The returned value | |
07fc65c4 GB |
1285 | -- is a copy of Pragma_Node, or Error if an error is found. Note that |
1286 | -- at the point where Prag is called, the right paren ending the pragma | |
1287 | -- has been scanned out, and except in the case of pragma Style_Checks, | |
1288 | -- so has the following semicolon. For Style_Checks, the caller delays | |
1289 | -- the scanning of the semicolon so that it will be scanned using the | |
1290 | -- settings from the Style_Checks pragma preceding it. | |
19235870 | 1291 | |
2820d220 AC |
1292 | -------------- |
1293 | -- Par.Labl -- | |
1294 | -------------- | |
19235870 RK |
1295 | |
1296 | procedure Labl; | |
2383acbd AC |
1297 | -- This procedure creates implicit label declarations for all labels that |
1298 | -- are declared in the current unit. Note that this could conceptually be | |
1299 | -- done at the point where the labels are declared, but it is tricky to do | |
1300 | -- it then, since the tree is not hooked up at the point where the label is | |
1301 | -- declared (e.g. a sequence of statements is not yet attached to its | |
1302 | -- containing scope at the point a label in the sequence is found). | |
19235870 | 1303 | |
2820d220 AC |
1304 | -------------- |
1305 | -- Par.Load -- | |
1306 | -------------- | |
1307 | ||
19235870 RK |
1308 | procedure Load; |
1309 | -- This procedure loads all subsidiary units that are required by this | |
1310 | -- unit, including with'ed units, specs for bodies, and parents for child | |
1311 | -- units. It does not load bodies for inlined procedures and generics, | |
1312 | -- since we don't know till semantic analysis is complete what is needed. | |
1313 | ||
1314 | ----------- | |
1315 | -- Stubs -- | |
1316 | ----------- | |
1317 | ||
1318 | -- The package bodies can see all routines defined in all other subpackages | |
1319 | ||
1320 | use Ch2; | |
1321 | use Ch3; | |
1322 | use Ch4; | |
1323 | use Ch5; | |
1324 | use Ch6; | |
1325 | use Ch7; | |
1326 | use Ch8; | |
1327 | use Ch9; | |
1328 | use Ch10; | |
1329 | use Ch11; | |
1330 | use Ch12; | |
1331 | use Ch13; | |
1332 | ||
1333 | use Endh; | |
1334 | use Tchk; | |
1335 | use Sync; | |
1336 | use Util; | |
1337 | ||
1338 | package body Ch2 is separate; | |
1339 | package body Ch3 is separate; | |
1340 | package body Ch4 is separate; | |
1341 | package body Ch5 is separate; | |
1342 | package body Ch6 is separate; | |
1343 | package body Ch7 is separate; | |
1344 | package body Ch8 is separate; | |
1345 | package body Ch9 is separate; | |
1346 | package body Ch10 is separate; | |
1347 | package body Ch11 is separate; | |
1348 | package body Ch12 is separate; | |
1349 | package body Ch13 is separate; | |
1350 | ||
1351 | package body Endh is separate; | |
1352 | package body Tchk is separate; | |
1353 | package body Sync is separate; | |
1354 | package body Util is separate; | |
1355 | ||
1356 | function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id | |
1357 | is separate; | |
1358 | ||
1359 | procedure Labl is separate; | |
1360 | procedure Load is separate; | |
1361 | ||
2820d220 | 1362 | -- Start of processing for Par |
19235870 RK |
1363 | |
1364 | begin | |
cd9909a0 | 1365 | Compiler_State := Parsing; |
2820d220 | 1366 | |
19235870 RK |
1367 | -- Deal with configuration pragmas case first |
1368 | ||
1369 | if Configuration_Pragmas then | |
1370 | declare | |
fbf5a39b | 1371 | Pragmas : constant List_Id := Empty_List; |
19235870 RK |
1372 | P_Node : Node_Id; |
1373 | ||
1374 | begin | |
1375 | loop | |
1376 | if Token = Tok_EOF then | |
cd9909a0 | 1377 | Compiler_State := Analyzing; |
19235870 RK |
1378 | return Pragmas; |
1379 | ||
1380 | elsif Token /= Tok_Pragma then | |
1381 | Error_Msg_SC ("only pragmas allowed in configuration file"); | |
cd9909a0 | 1382 | Compiler_State := Analyzing; |
19235870 RK |
1383 | return Error_List; |
1384 | ||
1385 | else | |
1386 | P_Node := P_Pragma; | |
1387 | ||
01af9aff | 1388 | if Nkind (P_Node) = N_Pragma then |
19235870 | 1389 | |
01af9aff AC |
1390 | -- Give error if bad pragma |
1391 | ||
3b8d33ef RD |
1392 | if not Is_Configuration_Pragma_Name (Pragma_Name (P_Node)) |
1393 | and then Pragma_Name (P_Node) /= Name_Source_Reference | |
01af9aff | 1394 | then |
3b8d33ef | 1395 | if Is_Pragma_Name (Pragma_Name (P_Node)) then |
01af9aff AC |
1396 | Error_Msg_N |
1397 | ("only configuration pragmas allowed " & | |
1398 | "in configuration file", P_Node); | |
1399 | else | |
1400 | Error_Msg_N | |
1401 | ("unrecognized pragma in configuration file", | |
1402 | P_Node); | |
1403 | end if; | |
19235870 | 1404 | |
01af9aff AC |
1405 | -- Pragma is OK config pragma, so collect it |
1406 | ||
1407 | else | |
1408 | Append (P_Node, Pragmas); | |
1409 | end if; | |
1410 | end if; | |
19235870 RK |
1411 | end if; |
1412 | end loop; | |
1413 | end; | |
1414 | ||
1415 | -- Normal case of compilation unit | |
1416 | ||
1417 | else | |
1418 | Save_Opt_Config_Switches (Save_Config_Switches); | |
1419 | ||
2820d220 AC |
1420 | -- The following loop runs more than once in syntax check mode |
1421 | -- where we allow multiple compilation units in the same file | |
1422 | -- and in Multiple_Unit_Per_file mode where we skip units till | |
1423 | -- we get to the unit we want. | |
19235870 | 1424 | |
2820d220 | 1425 | for Ucount in Pos loop |
19235870 | 1426 | Set_Opt_Config_Switches |
6e18b0e5 RD |
1427 | (Is_Internal_File_Name (File_Name (Current_Source_File)), |
1428 | Current_Source_Unit = Main_Unit); | |
19235870 RK |
1429 | |
1430 | -- Initialize scope table and other parser control variables | |
1431 | ||
1432 | Compiler_State := Parsing; | |
1433 | Scope.Init; | |
1434 | Scope.Increment_Last; | |
1435 | Scope.Table (0).Etyp := E_Dummy; | |
1436 | SIS_Entry_Active := False; | |
1437 | Last_Resync_Point := No_Location; | |
1438 | ||
523456db | 1439 | Goto_List := New_Elmt_List; |
19235870 | 1440 | Label_List := New_Elmt_List; |
19235870 | 1441 | |
2820d220 AC |
1442 | -- If in multiple unit per file mode, skip past ignored unit |
1443 | ||
1444 | if Ucount < Multiple_Unit_Index then | |
1445 | ||
892125cd AC |
1446 | -- We skip in syntax check only mode, since we don't want to do |
1447 | -- anything more than skip past the unit and ignore it. This means | |
1448 | -- we skip processing like setting up a unit table entry. | |
2820d220 AC |
1449 | |
1450 | declare | |
1451 | Save_Operating_Mode : constant Operating_Mode_Type := | |
1452 | Operating_Mode; | |
1453 | ||
6b6fcd3e AC |
1454 | Save_Style_Check : constant Boolean := Style_Check; |
1455 | ||
2820d220 AC |
1456 | begin |
1457 | Operating_Mode := Check_Syntax; | |
6b6fcd3e | 1458 | Style_Check := False; |
2820d220 AC |
1459 | Discard_Node (P_Compilation_Unit); |
1460 | Operating_Mode := Save_Operating_Mode; | |
6b6fcd3e | 1461 | Style_Check := Save_Style_Check; |
2820d220 | 1462 | |
3a336262 AC |
1463 | -- If we are at an end of file, and not yet at the right unit, |
1464 | -- then we have a fatal error. The unit is missing. | |
2820d220 AC |
1465 | |
1466 | if Token = Tok_EOF then | |
1467 | Error_Msg_SC ("file has too few compilation units"); | |
1468 | raise Unrecoverable_Error; | |
1469 | end if; | |
1470 | end; | |
1471 | ||
3a336262 AC |
1472 | -- Here if we are not skipping a file in multiple unit per file mode. |
1473 | -- Parse the unit that we are interested in. Note that in check | |
1474 | -- syntax mode we are interested in all units in the file. | |
2820d220 AC |
1475 | |
1476 | else | |
6b6fcd3e AC |
1477 | declare |
1478 | Comp_Unit_Node : constant Node_Id := P_Compilation_Unit; | |
1479 | ||
1480 | begin | |
1481 | -- If parsing was successful and we are not in check syntax | |
ae6ede77 | 1482 | -- mode, check that language-defined units are compiled in GNAT |
3a336262 AC |
1483 | -- mode. For this purpose we do NOT consider renamings in annex |
1484 | -- J as predefined. That allows users to compile their own | |
1485 | -- versions of these files, and in particular, in the VMS | |
1486 | -- implementation, the DEC versions can be substituted for the | |
1487 | -- standard Ada 95 versions. Another exception is System.RPC | |
1488 | -- and its children. This allows a user to supply their own | |
1489 | -- communication layer. | |
6b6fcd3e AC |
1490 | |
1491 | if Comp_Unit_Node /= Error | |
1492 | and then Operating_Mode = Generate_Code | |
1493 | and then Current_Source_Unit = Main_Unit | |
1494 | and then not GNAT_Mode | |
1495 | then | |
1496 | declare | |
af152989 AC |
1497 | Uname : constant String := |
1498 | Get_Name_String | |
1499 | (Unit_Name (Current_Source_Unit)); | |
88b32fc3 | 1500 | Name : String (1 .. Uname'Length - 2); |
af152989 | 1501 | |
6b6fcd3e | 1502 | begin |
3a336262 AC |
1503 | -- Because Unit_Name includes "%s"/"%b", we need to strip |
1504 | -- the last two characters to get the real unit name. | |
af152989 AC |
1505 | |
1506 | Name := Uname (Uname'First .. Uname'Last - 2); | |
1507 | ||
958a816e VC |
1508 | if Name = "ada" or else |
1509 | Name = "interfaces" or else | |
1510 | Name = "system" | |
bac0819a RD |
1511 | then |
1512 | Error_Msg | |
ae6ede77 | 1513 | ("language-defined units cannot be recompiled", |
bac0819a RD |
1514 | Sloc (Unit (Comp_Unit_Node))); |
1515 | ||
1516 | elsif Name'Length > 4 | |
1517 | and then | |
1518 | Name (Name'First .. Name'First + 3) = "ada." | |
1519 | then | |
1520 | Error_Msg | |
ae6ede77 AC |
1521 | ("user-defined descendents of package Ada " & |
1522 | "are not allowed", | |
bac0819a RD |
1523 | Sloc (Unit (Comp_Unit_Node))); |
1524 | ||
1525 | elsif Name'Length > 11 | |
1526 | and then | |
1527 | Name (Name'First .. Name'First + 10) = "interfaces." | |
1528 | then | |
1529 | Error_Msg | |
ae6ede77 AC |
1530 | ("user-defined descendents of package Interfaces " & |
1531 | "are not allowed", | |
bac0819a RD |
1532 | Sloc (Unit (Comp_Unit_Node))); |
1533 | ||
1534 | elsif Name'Length > 7 | |
1535 | and then Name (Name'First .. Name'First + 6) = "system." | |
6b6fcd3e AC |
1536 | and then Name /= "system.rpc" |
1537 | and then | |
1538 | (Name'Length < 11 | |
1539 | or else Name (Name'First .. Name'First + 10) /= | |
1540 | "system.rpc.") | |
1541 | then | |
1542 | Error_Msg | |
ae6ede77 AC |
1543 | ("user-defined descendents of package System " & |
1544 | "are not allowed", | |
6b6fcd3e AC |
1545 | Sloc (Unit (Comp_Unit_Node))); |
1546 | end if; | |
1547 | end; | |
1548 | end if; | |
1549 | end; | |
2820d220 AC |
1550 | |
1551 | -- All done if at end of file | |
1552 | ||
1553 | exit when Token = Tok_EOF; | |
1554 | ||
1555 | -- If we are not at an end of file, it means we are in syntax | |
1556 | -- check only mode, and we keep the loop going to parse all | |
1557 | -- remaining units in the file. | |
1558 | ||
1559 | end if; | |
19235870 | 1560 | |
19235870 | 1561 | Restore_Opt_Config_Switches (Save_Config_Switches); |
19235870 RK |
1562 | end loop; |
1563 | ||
3a336262 AC |
1564 | -- Now that we have completely parsed the source file, we can complete |
1565 | -- the source file table entry. | |
19235870 RK |
1566 | |
1567 | Complete_Source_File_Entry; | |
1568 | ||
1569 | -- An internal error check, the scope stack should now be empty | |
1570 | ||
1571 | pragma Assert (Scope.Last = 0); | |
1572 | ||
892125cd | 1573 | -- Here we make the SCO table entries for the main unit |
6f12117a | 1574 | |
892125cd AC |
1575 | if Generate_SCO then |
1576 | SCO_Record (Main_Unit); | |
6f12117a RD |
1577 | end if; |
1578 | ||
1579 | -- Remaining steps are to create implicit label declarations and to load | |
1580 | -- required subsidiary sources. These steps are required only if we are | |
1581 | -- doing semantic checking. | |
19235870 RK |
1582 | |
1583 | if Operating_Mode /= Check_Syntax or else Debug_Flag_F then | |
1584 | Par.Labl; | |
1585 | Par.Load; | |
1586 | end if; | |
1587 | ||
1588 | -- Restore settings of switches saved on entry | |
1589 | ||
1590 | Restore_Opt_Config_Switches (Save_Config_Switches); | |
1591 | Set_Comes_From_Source_Default (False); | |
cd9909a0 | 1592 | Compiler_State := Analyzing; |
19235870 RK |
1593 | return Empty_List; |
1594 | end if; | |
19235870 | 1595 | end Par; |