]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- G N A T P R E P -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
07fc65c4 | 9 | -- Copyright (C) 1996-2002, Free Software Foundation, Inc. -- |
38cbfe40 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- -- | |
13 | -- ware Foundation; either version 2, or (at your option) any later ver- -- | |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNAT; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
38cbfe40 RK |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
27 | with Ada.Characters.Handling; use Ada.Characters.Handling; | |
28 | with Ada.Strings.Fixed; | |
29 | with Ada.Command_Line; use Ada.Command_Line; | |
30 | with Ada.Text_IO; use Ada.Text_IO; | |
31 | ||
32 | with GNAT.Heap_Sort_G; | |
33 | with GNAT.Command_Line; | |
34 | ||
35 | with Gnatvsn; | |
36 | ||
37 | procedure GNATprep is | |
38cbfe40 | 38 | |
38cbfe40 RK |
39 | type Strptr is access String; |
40 | ||
41 | Usage_Error : exception; | |
42 | -- Raised if a usage error is detected, causes termination of processing | |
43 | -- with an appropriate error message and error exit status set. | |
44 | ||
45 | Fatal_Error : exception; | |
46 | -- Exception raised if fatal error detected | |
47 | ||
48 | Expression_Error : exception; | |
49 | -- Exception raised when an invalid boolean expression is found | |
50 | -- on a preprocessor line | |
51 | ||
52 | ------------------------ | |
53 | -- Argument Line Data -- | |
54 | ------------------------ | |
55 | ||
38cbfe40 RK |
56 | Outfile_Name : Strptr; |
57 | Deffile_Name : Strptr; | |
58 | -- Names of files | |
59 | ||
07fc65c4 GB |
60 | type Input; |
61 | type Input_Ptr is access Input; | |
62 | type Input is record | |
63 | File : File_Type; | |
64 | Next : Input_Ptr; | |
65 | Prev : Input_Ptr; | |
66 | Name : Strptr; | |
67 | Line_Num : Natural := 0; | |
68 | end record; | |
69 | -- Data for the current input file (main input file or included file | |
70 | -- or definition file). | |
71 | ||
72 | Infile : Input_Ptr := new Input; | |
38cbfe40 RK |
73 | Outfile : File_Type; |
74 | Deffile : File_Type; | |
75 | ||
76 | Opt_Comment_Deleted_Lines : Boolean := False; -- Set if -c switch set | |
77 | Blank_Deleted_Lines : Boolean := False; -- Set if -b switch set | |
78 | List_Symbols : Boolean := False; -- Set if -s switch set | |
79 | Source_Ref_Pragma : Boolean := False; -- Set if -r switch set | |
80 | Undefined_Is_False : Boolean := False; -- Set if -u switch set | |
81 | -- Record command line options | |
82 | ||
83 | --------------------------- | |
84 | -- Definitions File Data -- | |
85 | --------------------------- | |
86 | ||
87 | Num_Syms : Natural := 0; | |
88 | -- Number of symbols defined in definitions file | |
89 | ||
90 | Symbols : array (0 .. 10_000) of Strptr; | |
91 | Values : array (0 .. 10_000) of Strptr; | |
92 | -- Symbol names and values. Note that the zero'th element is used only | |
93 | -- during the call to Sort (to hold a temporary value, as required by | |
94 | -- the GNAT.Heap_Sort_G interface). | |
95 | ||
96 | --------------------- | |
97 | -- Input File Data -- | |
98 | --------------------- | |
99 | ||
100 | Current_File_Name : Strptr; | |
101 | -- Holds name of file being read (definitions file or input file) | |
102 | ||
103 | Line_Buffer : String (1 .. 20_000); | |
104 | -- Hold one line | |
105 | ||
106 | Line_Length : Natural; | |
107 | -- Length of line in Line_Buffer | |
108 | ||
38cbfe40 RK |
109 | Ptr : Natural; |
110 | -- Input scan pointer for line in Line_Buffer | |
111 | ||
112 | type Keyword is (K_Not, K_Then, K_If, K_Else, K_End, K_Elsif, | |
113 | K_And, K_Or, K_Open_Paren, K_Close_Paren, | |
07fc65c4 GB |
114 | K_Defined, K_Andthen, K_Orelse, K_Equal, K_Include, |
115 | K_None); | |
38cbfe40 RK |
116 | -- Keywords that are recognized on preprocessor lines. K_None indicates |
117 | -- that no keyword was present. | |
118 | ||
119 | K : Keyword; | |
120 | -- Scanned keyword | |
121 | ||
122 | Start_Sym, End_Sym : Natural; | |
123 | -- First and last positions of scanned symbol | |
124 | ||
125 | Num_Errors : Natural := 0; | |
126 | -- Number of errors detected | |
127 | ||
128 | ----------------------- | |
129 | -- Preprocessor Data -- | |
130 | ----------------------- | |
131 | ||
132 | -- The following record represents the state of an #if structure: | |
133 | ||
134 | type PP_Rec is record | |
135 | If_Line : Positive; | |
136 | -- Line number for #if line | |
137 | ||
07fc65c4 GB |
138 | If_Name : Strptr; |
139 | -- File name of #if line | |
140 | ||
38cbfe40 RK |
141 | Else_Line : Natural; |
142 | -- Line number for #else line, zero = no else seen yet | |
143 | ||
144 | Deleting : Boolean; | |
145 | -- True if lines currently being deleted | |
146 | ||
147 | Match_Seen : Boolean; | |
148 | -- True if either the #if condition or one of the previously seen | |
149 | -- #elsif lines was true, meaning that any future #elsif sections | |
150 | -- or the #else section, is to be deleted. | |
07fc65c4 | 151 | |
38cbfe40 RK |
152 | end record; |
153 | ||
154 | PP_Depth : Natural; | |
155 | -- Preprocessor #if nesting level. A value of zero means that we are | |
156 | -- outside any #if structure. | |
157 | ||
158 | PP : array (0 .. 100) of PP_Rec; | |
159 | -- Stack of records showing state of #if structures. PP (1) is the | |
160 | -- outer level entry, and PP (PP_Depth) is the active entry. PP (0) | |
161 | -- contains a dummy entry whose Deleting flag is always set to False. | |
162 | ||
163 | ----------------- | |
164 | -- Subprograms -- | |
165 | ----------------- | |
166 | ||
167 | function At_End_Of_Line return Boolean; | |
168 | -- First advances Ptr using Skip_Spaces. Then returns True if Ptr is | |
169 | -- either at the end of the line, or at a -- comment sequence. | |
170 | ||
171 | procedure Error (Msg : String); | |
172 | -- Post error message with given text. The line number is taken from | |
07fc65c4 | 173 | -- Infile.Line_Num, and the column number from Ptr. |
38cbfe40 RK |
174 | |
175 | function Eval_Condition | |
176 | (Parenthesis : Natural := 0; | |
177 | Do_Eval : Boolean := True) | |
178 | return Boolean; | |
179 | -- Eval the condition found in the current Line. The condition can | |
180 | -- include any of the 'and', 'or', 'not', and parenthesis subexpressions. | |
181 | -- If Line is an invalid expression, then Expression_Error is raised, | |
182 | -- after an error message has been printed. Line can include 'then' | |
183 | -- followed by a comment, which is automatically ignored. If Do_Eval | |
184 | -- is False, then the expression is not evaluated at all, and symbols | |
185 | -- are just skipped. | |
186 | ||
187 | function Eval_Symbol (Do_Eval : Boolean) return Boolean; | |
188 | -- Read and evaluate the next symbol or expression (A, A'Defined, A=...) | |
189 | -- If it is followed by 'Defined or an equality test, read as many symbols | |
190 | -- as needed. Do_Eval has the same meaning as in Eval_Condition | |
191 | ||
192 | procedure Help_Page; | |
193 | -- Print a help page to summarize the usage of gnatprep | |
194 | ||
07fc65c4 GB |
195 | function Image (N : Natural) return String; |
196 | -- Returns Natural'Image (N) without the initial space | |
197 | ||
38cbfe40 RK |
198 | function Is_Preprocessor_Line return Boolean; |
199 | -- Tests if current line is a preprocessor line, i.e. that its first | |
200 | -- non-blank character is a # character. If so, then a result of True | |
201 | -- is returned, and Ptr is set to point to the character following the | |
202 | -- # character. If not, False is returned and Ptr is undefined. | |
203 | ||
204 | procedure No_Junk; | |
205 | -- Make sure no junk is present on a preprocessor line. Ptr points past | |
206 | -- the scanned preprocessor syntax. | |
207 | ||
208 | function OK_Identifier (S : String) return Boolean; | |
209 | -- Tests if given referenced string is valid Ada identifier | |
210 | ||
211 | function Matching_Strings (S1, S2 : String) return Boolean; | |
212 | -- Check if S1 and S2 are the same string (this is a case independent | |
213 | -- comparison, lower and upper case letters are considered to match). | |
214 | -- Duplicate quotes in S2 are considered as a single quote ("" => ") | |
215 | ||
216 | procedure Parse_Def_File; | |
217 | -- Parse the deffile given by the user | |
218 | ||
219 | function Scan_Keyword return Keyword; | |
220 | -- Advances Ptr to end of line or next non-blank using Skip_Spaces. Then | |
221 | -- attempts to scan out a recognized keyword. if a recognized keyword is | |
222 | -- found, sets Ptr past it, and returns the code for the keyword, if not, | |
223 | -- then Ptr is left unchanged pointing to a non-blank character or to the | |
224 | -- end of the line. | |
225 | ||
226 | function Symbol_Scanned return Boolean; | |
227 | -- On entry, Start_Sym is set to the first character of an identifier | |
228 | -- symbol to be scanned out. On return, End_Sym is set to the last | |
229 | -- character of the identifier, and the result indicates if the scanned | |
230 | -- symbol is a valid identifier (True = valid). Ptr is not changed. | |
231 | ||
232 | procedure Skip_Spaces; | |
233 | -- Skips Ptr past tabs and spaces to next non-blank, or one character | |
234 | -- past the end of line. | |
235 | ||
236 | function Variable_Index (Name : String) return Natural; | |
237 | -- Returns the index of the variable in the table. If the variable is not | |
238 | -- found, returns Natural'Last | |
239 | ||
240 | -------------------- | |
241 | -- At_End_Of_Line -- | |
242 | -------------------- | |
243 | ||
244 | function At_End_Of_Line return Boolean is | |
245 | begin | |
246 | Skip_Spaces; | |
247 | ||
248 | return Ptr > Line_Length | |
249 | or else | |
250 | (Ptr < Line_Length and then Line_Buffer (Ptr .. Ptr + 1) = "--"); | |
251 | end At_End_Of_Line; | |
252 | ||
253 | ----------- | |
254 | -- Error -- | |
255 | ----------- | |
256 | ||
257 | procedure Error (Msg : String) is | |
07fc65c4 | 258 | L : constant String := Natural'Image (Infile.Line_Num); |
38cbfe40 RK |
259 | C : constant String := Natural'Image (Ptr); |
260 | ||
261 | begin | |
262 | Put (Standard_Error, Current_File_Name.all); | |
263 | Put (Standard_Error, ':'); | |
264 | Put (Standard_Error, L (2 .. L'Length)); | |
265 | Put (Standard_Error, ':'); | |
266 | Put (Standard_Error, C (2 .. C'Length)); | |
267 | Put (Standard_Error, ": "); | |
268 | ||
269 | Put_Line (Standard_Error, Msg); | |
270 | Num_Errors := Num_Errors + 1; | |
271 | end Error; | |
272 | ||
273 | -------------------- | |
274 | -- Eval_Condition -- | |
275 | -------------------- | |
276 | ||
277 | function Eval_Condition | |
278 | (Parenthesis : Natural := 0; | |
279 | Do_Eval : Boolean := True) | |
280 | return Boolean | |
281 | is | |
282 | Symbol_Is_True : Boolean := False; -- init to avoid warning | |
283 | K : Keyword; | |
284 | ||
285 | begin | |
286 | -- Find the next subexpression | |
287 | ||
288 | K := Scan_Keyword; | |
289 | ||
290 | case K is | |
291 | when K_None => | |
292 | Symbol_Is_True := Eval_Symbol (Do_Eval); | |
293 | ||
294 | when K_Not => | |
295 | ||
296 | -- Not applies to the next subexpression (either a simple | |
297 | -- evaluation like A or A'Defined, or a parenthesis expression) | |
298 | ||
299 | K := Scan_Keyword; | |
300 | ||
301 | if K = K_Open_Paren then | |
302 | Symbol_Is_True := not Eval_Condition (Parenthesis + 1, Do_Eval); | |
303 | ||
304 | elsif K = K_None then | |
305 | Symbol_Is_True := not Eval_Symbol (Do_Eval); | |
306 | ||
307 | else | |
308 | Ptr := Start_Sym; -- Puts the keyword back | |
309 | end if; | |
310 | ||
311 | when K_Open_Paren => | |
312 | Symbol_Is_True := Eval_Condition (Parenthesis + 1, Do_Eval); | |
313 | ||
314 | when others => | |
315 | Ptr := Start_Sym; | |
316 | Error ("invalid syntax in preprocessor line"); | |
317 | raise Expression_Error; | |
318 | end case; | |
319 | ||
320 | -- Do we have a compound expression with AND, OR, ... | |
321 | ||
322 | K := Scan_Keyword; | |
323 | case K is | |
324 | when K_None => | |
325 | if not At_End_Of_Line then | |
326 | Error ("Invalid Syntax at end of line"); | |
327 | raise Expression_Error; | |
328 | end if; | |
329 | ||
330 | if Parenthesis /= 0 then | |
331 | Error ("Unmatched opening parenthesis"); | |
332 | raise Expression_Error; | |
333 | end if; | |
334 | ||
335 | return Symbol_Is_True; | |
336 | ||
337 | when K_Then => | |
338 | if Parenthesis /= 0 then | |
339 | Error ("Unmatched opening parenthesis"); | |
340 | raise Expression_Error; | |
341 | end if; | |
342 | ||
343 | return Symbol_Is_True; | |
344 | ||
345 | when K_Close_Paren => | |
346 | if Parenthesis = 0 then | |
347 | Error ("Unmatched closing parenthesis"); | |
348 | raise Expression_Error; | |
349 | end if; | |
350 | ||
351 | return Symbol_Is_True; | |
352 | ||
353 | when K_And => | |
354 | return Symbol_Is_True and Eval_Condition (Parenthesis, Do_Eval); | |
355 | ||
356 | when K_Andthen => | |
357 | if not Symbol_Is_True then | |
358 | ||
359 | -- Just skip the symbols for the remaining part | |
360 | ||
361 | Symbol_Is_True := Eval_Condition (Parenthesis, False); | |
362 | return False; | |
363 | ||
364 | else | |
365 | return Eval_Condition (Parenthesis, Do_Eval); | |
366 | end if; | |
367 | ||
368 | when K_Or => | |
369 | return Symbol_Is_True or Eval_Condition (Parenthesis, Do_Eval); | |
370 | ||
371 | when K_Orelse => | |
372 | if Symbol_Is_True then | |
373 | ||
374 | -- Just skip the symbols for the remaining part | |
375 | ||
376 | Symbol_Is_True := Eval_Condition (Parenthesis, False); | |
377 | return True; | |
378 | ||
379 | else | |
380 | return Eval_Condition (Parenthesis, Do_Eval); | |
381 | end if; | |
382 | ||
383 | when others => | |
384 | Error ("invalid syntax in preprocessor line"); | |
385 | raise Expression_Error; | |
386 | end case; | |
387 | ||
388 | end Eval_Condition; | |
389 | ||
390 | ----------------- | |
391 | -- Eval_Symbol -- | |
392 | ----------------- | |
393 | ||
394 | function Eval_Symbol (Do_Eval : Boolean) return Boolean is | |
395 | Sym : constant String := Line_Buffer (Start_Sym .. End_Sym); | |
396 | K : Keyword; | |
397 | Index : Natural; | |
398 | Symbol_Defined : Boolean := False; | |
399 | Symbol_Is_True : Boolean := False; | |
400 | ||
401 | begin | |
402 | -- Read the symbol | |
403 | ||
404 | Skip_Spaces; | |
405 | Start_Sym := Ptr; | |
406 | ||
407 | if not Symbol_Scanned then | |
408 | Error ("invalid symbol name"); | |
409 | raise Expression_Error; | |
410 | end if; | |
411 | ||
412 | Ptr := End_Sym + 1; | |
413 | ||
414 | -- Test if we have a simple test (A) or a more complicated one | |
415 | -- (A'Defined) | |
416 | ||
417 | K := Scan_Keyword; | |
418 | ||
419 | if K /= K_Defined and then K /= K_Equal then | |
420 | Ptr := Start_Sym; -- Puts the keyword back | |
421 | end if; | |
422 | ||
423 | Index := Variable_Index (Sym); | |
424 | ||
425 | case K is | |
426 | when K_Defined => | |
427 | Symbol_Defined := Index /= Natural'Last; | |
428 | Symbol_Is_True := Symbol_Defined; | |
429 | ||
430 | when K_Equal => | |
431 | ||
432 | -- Read the second part of the statement | |
07fc65c4 | 433 | |
38cbfe40 RK |
434 | Skip_Spaces; |
435 | Start_Sym := Ptr; | |
436 | ||
437 | if not Symbol_Scanned | |
438 | and then End_Sym < Start_Sym | |
439 | then | |
440 | Error ("No right part for the equality test"); | |
441 | raise Expression_Error; | |
442 | end if; | |
443 | ||
444 | Ptr := End_Sym + 1; | |
445 | ||
446 | -- If the variable was not found | |
447 | ||
448 | if Do_Eval then | |
449 | if Index = Natural'Last then | |
450 | if not Undefined_Is_False then | |
451 | Error ("symbol name """ & Sym & | |
452 | """ is not defined in definitions file"); | |
453 | end if; | |
454 | ||
455 | else | |
456 | declare | |
457 | Right : constant String | |
458 | := Line_Buffer (Start_Sym .. End_Sym); | |
459 | Index_R : Natural; | |
460 | begin | |
461 | if Right (Right'First) = '"' then | |
462 | Symbol_Is_True := | |
463 | Matching_Strings | |
464 | (Values (Index).all, | |
465 | Right (Right'First + 1 .. Right'Last - 1)); | |
466 | else | |
467 | Index_R := Variable_Index (Right); | |
468 | if Index_R = Natural'Last then | |
469 | Error ("Variable " & Right & " in test is " | |
470 | & "not defined"); | |
471 | raise Expression_Error; | |
472 | else | |
473 | Symbol_Is_True := | |
474 | Matching_Strings (Values (Index).all, | |
475 | Values (Index_R).all); | |
476 | end if; | |
477 | end if; | |
478 | end; | |
479 | end if; | |
480 | end if; | |
481 | ||
482 | when others => | |
483 | ||
484 | if Index = Natural'Last then | |
485 | ||
486 | Symbol_Defined := False; | |
487 | if Do_Eval and then not Symbol_Defined then | |
488 | if Undefined_Is_False then | |
489 | Symbol_Defined := True; | |
490 | Symbol_Is_True := False; | |
491 | ||
492 | else | |
493 | Error | |
494 | ("symbol name """ & Sym & | |
495 | """ is not defined in definitions file"); | |
496 | end if; | |
497 | end if; | |
498 | ||
499 | elsif not Do_Eval then | |
500 | Symbol_Is_True := True; | |
501 | ||
502 | elsif Matching_Strings (Values (Index).all, "True") then | |
503 | Symbol_Is_True := True; | |
504 | ||
505 | elsif Matching_Strings (Values (Index).all, "False") then | |
506 | Symbol_Is_True := False; | |
507 | ||
508 | else | |
509 | Error ("symbol value is not True or False"); | |
510 | Symbol_Is_True := False; | |
511 | end if; | |
512 | ||
513 | end case; | |
514 | ||
515 | return Symbol_Is_True; | |
516 | end Eval_Symbol; | |
517 | ||
518 | --------------- | |
519 | -- Help_Page -- | |
520 | --------------- | |
521 | ||
522 | procedure Help_Page is | |
523 | begin | |
524 | Put_Line (Standard_Error, | |
07fc65c4 GB |
525 | "GNAT Preprocessor " & |
526 | Gnatvsn.Gnat_Version_String & | |
527 | " Copyright 1996-2002 Free Software Foundation, Inc."); | |
38cbfe40 RK |
528 | Put_Line (Standard_Error, |
529 | "Usage: gnatprep [-bcrsu] [-Dsymbol=value] infile " & | |
530 | "outfile [deffile]"); | |
531 | New_Line (Standard_Error); | |
532 | Put_Line (Standard_Error, " infile Name of the input file"); | |
533 | Put_Line (Standard_Error, " outfile Name of the output file"); | |
534 | Put_Line (Standard_Error, " deffile Name of the definition file"); | |
535 | New_Line (Standard_Error); | |
536 | Put_Line (Standard_Error, "gnatprep switches:"); | |
537 | Put_Line (Standard_Error, " -b Replace preprocessor lines by " & | |
538 | "blank lines"); | |
539 | Put_Line (Standard_Error, " -c Keep preprocessor lines as comments"); | |
540 | Put_Line (Standard_Error, " -D Associate symbol with value"); | |
541 | Put_Line (Standard_Error, " -r Generate Source_Reference pragma"); | |
542 | Put_Line (Standard_Error, " -s Print a sorted list of symbol names " & | |
543 | "and values"); | |
544 | Put_Line (Standard_Error, " -u Treat undefined symbols as FALSE"); | |
545 | New_Line (Standard_Error); | |
546 | end Help_Page; | |
547 | ||
07fc65c4 GB |
548 | ----------- |
549 | -- Image -- | |
550 | ----------- | |
551 | ||
552 | function Image (N : Natural) return String is | |
553 | Result : constant String := Natural'Image (N); | |
554 | begin | |
555 | return Result (Result'First + 1 .. Result'Last); | |
556 | end Image; | |
557 | ||
38cbfe40 RK |
558 | -------------------------- |
559 | -- Is_Preprocessor_Line -- | |
560 | -------------------------- | |
561 | ||
562 | function Is_Preprocessor_Line return Boolean is | |
563 | begin | |
564 | Ptr := 1; | |
565 | ||
566 | while Ptr <= Line_Length loop | |
567 | if Line_Buffer (Ptr) = '#' then | |
568 | Ptr := Ptr + 1; | |
569 | return True; | |
570 | ||
571 | elsif Line_Buffer (Ptr) > ' ' then | |
572 | return False; | |
573 | ||
574 | else | |
575 | Ptr := Ptr + 1; | |
576 | end if; | |
577 | end loop; | |
578 | ||
579 | return False; | |
580 | end Is_Preprocessor_Line; | |
581 | ||
582 | ---------------------- | |
583 | -- Matching_Strings -- | |
584 | ---------------------- | |
585 | ||
586 | function Matching_Strings (S1, S2 : String) return Boolean is | |
587 | S2_Index : Integer := S2'First; | |
588 | ||
589 | begin | |
590 | for S1_Index in S1'Range loop | |
591 | ||
592 | if To_Upper (S1 (S1_Index)) /= To_Upper (S2 (S2_Index)) then | |
593 | return False; | |
594 | ||
595 | else | |
596 | if S2 (S2_Index) = '"' | |
597 | and then S2_Index < S2'Last | |
598 | and then S2 (S2_Index + 1) = '"' | |
599 | then | |
600 | S2_Index := S2_Index + 2; | |
601 | else | |
602 | S2_Index := S2_Index + 1; | |
603 | end if; | |
604 | ||
605 | -- If S2 was too short then | |
606 | ||
607 | if S2_Index > S2'Last and then S1_Index < S1'Last then | |
608 | return False; | |
609 | end if; | |
610 | end if; | |
611 | end loop; | |
612 | ||
613 | return S2_Index = S2'Last + 1; | |
614 | end Matching_Strings; | |
615 | ||
616 | ------------- | |
617 | -- No_Junk -- | |
618 | ------------- | |
619 | ||
620 | procedure No_Junk is | |
621 | begin | |
622 | Skip_Spaces; | |
623 | ||
624 | if Ptr = Line_Length | |
625 | or else (Ptr < Line_Length | |
626 | and then Line_Buffer (Ptr .. Ptr + 1) /= "--") | |
627 | then | |
628 | Error ("extraneous text on preprocessor line ignored"); | |
629 | end if; | |
630 | end No_Junk; | |
631 | ||
632 | ------------------- | |
633 | -- OK_Identifier -- | |
634 | ------------------- | |
635 | ||
636 | function OK_Identifier (S : String) return Boolean is | |
637 | P : Natural := S'First; | |
638 | ||
639 | begin | |
640 | if S'Length /= 0 and then S (P) = Character'Val (39) then -- ''' | |
641 | P := P + 1; | |
642 | end if; | |
643 | ||
644 | if S'Length = 0 | |
645 | or else not Is_Letter (S (P)) | |
646 | then | |
647 | return False; | |
648 | ||
649 | else | |
650 | while P <= S'Last loop | |
651 | if Is_Letter (S (P)) or Is_Digit (S (P)) then | |
652 | null; | |
653 | ||
654 | elsif S (P) = '_' | |
655 | and then P < S'Last | |
656 | and then S (P + 1) /= '_' | |
657 | then | |
658 | null; | |
659 | ||
660 | else | |
661 | return False; | |
662 | end if; | |
663 | ||
664 | P := P + 1; | |
665 | end loop; | |
666 | ||
667 | return True; | |
668 | end if; | |
669 | end OK_Identifier; | |
670 | ||
671 | -------------------- | |
672 | -- Parse_Def_File -- | |
673 | -------------------- | |
674 | ||
675 | procedure Parse_Def_File is | |
676 | begin | |
677 | Open (Deffile, In_File, Deffile_Name.all); | |
678 | ||
07fc65c4 GB |
679 | -- Initialize data for procedure Error |
680 | ||
681 | Infile.Line_Num := 0; | |
38cbfe40 RK |
682 | Current_File_Name := Deffile_Name; |
683 | ||
684 | -- Loop through lines in symbol definitions file | |
685 | ||
686 | while not End_Of_File (Deffile) loop | |
687 | Get_Line (Deffile, Line_Buffer, Line_Length); | |
07fc65c4 | 688 | Infile.Line_Num := Infile.Line_Num + 1; |
38cbfe40 RK |
689 | |
690 | Ptr := 1; | |
691 | Skip_Spaces; | |
692 | ||
693 | if Ptr > Line_Length | |
694 | or else (Ptr < Line_Length | |
695 | and then | |
696 | Line_Buffer (Ptr .. Ptr + 1) = "--") | |
697 | then | |
698 | goto Continue; | |
699 | end if; | |
700 | ||
701 | Start_Sym := Ptr; | |
702 | ||
703 | if not Symbol_Scanned then | |
704 | Error ("invalid symbol identifier """ & | |
705 | Line_Buffer (Start_Sym .. End_Sym) & | |
706 | '"'); | |
707 | goto Continue; | |
708 | end if; | |
709 | ||
710 | Ptr := End_Sym + 1; | |
711 | Skip_Spaces; | |
712 | ||
713 | if Ptr >= Line_Length | |
714 | or else Line_Buffer (Ptr .. Ptr + 1) /= ":=" | |
715 | then | |
716 | Error ("missing "":="" in symbol definition line"); | |
717 | goto Continue; | |
718 | end if; | |
719 | ||
720 | Ptr := Ptr + 2; | |
721 | Skip_Spaces; | |
722 | ||
723 | Num_Syms := Num_Syms + 1; | |
724 | Symbols (Num_Syms) := new String'(Line_Buffer (Start_Sym .. End_Sym)); | |
725 | ||
726 | Start_Sym := Ptr; | |
727 | End_Sym := Ptr - 1; | |
728 | ||
729 | if At_End_Of_Line then | |
730 | null; | |
731 | ||
732 | elsif Line_Buffer (Start_Sym) = '"' then | |
733 | End_Sym := End_Sym + 1; | |
734 | loop | |
735 | End_Sym := End_Sym + 1; | |
736 | ||
737 | if End_Sym > Line_Length then | |
738 | Error ("no closing quote for string constant"); | |
739 | goto Continue; | |
740 | ||
741 | elsif End_Sym < Line_Length | |
742 | and then Line_Buffer (End_Sym .. End_Sym + 1) = """""" | |
743 | then | |
744 | End_Sym := End_Sym + 1; | |
745 | ||
746 | elsif Line_Buffer (End_Sym) = '"' then | |
747 | exit; | |
748 | end if; | |
749 | end loop; | |
750 | ||
751 | else | |
752 | End_Sym := Ptr - 1; | |
753 | ||
754 | while End_Sym < Line_Length | |
755 | and then (Is_Alphanumeric (Line_Buffer (End_Sym + 1)) | |
756 | or else | |
757 | Line_Buffer (End_Sym + 1) = '_' | |
758 | or else | |
759 | Line_Buffer (End_Sym + 1) = '.') | |
760 | loop | |
761 | End_Sym := End_Sym + 1; | |
762 | end loop; | |
763 | ||
764 | Ptr := End_Sym + 1; | |
765 | ||
766 | if not At_End_Of_Line then | |
767 | Error ("incorrect symbol value syntax"); | |
768 | goto Continue; | |
769 | end if; | |
770 | end if; | |
771 | ||
772 | Values (Num_Syms) := new String'(Line_Buffer (Start_Sym .. End_Sym)); | |
773 | ||
774 | <<Continue>> | |
775 | null; | |
776 | end loop; | |
777 | ||
778 | exception | |
779 | -- Could not open the file | |
780 | ||
781 | when Name_Error => | |
782 | Put_Line (Standard_Error, "cannot open " & Deffile_Name.all); | |
783 | raise Fatal_Error; | |
784 | end Parse_Def_File; | |
785 | ||
786 | ------------------ | |
787 | -- Scan_Keyword -- | |
788 | ------------------ | |
789 | ||
790 | function Scan_Keyword return Keyword is | |
791 | Kptr : constant Natural := Ptr; | |
792 | ||
793 | begin | |
794 | Skip_Spaces; | |
795 | Start_Sym := Ptr; | |
796 | ||
797 | if Symbol_Scanned then | |
798 | ||
799 | -- If the symbol was the last thing on the line, End_Sym will | |
800 | -- point too far in Line_Buffer | |
801 | ||
802 | if End_Sym > Line_Length then | |
803 | End_Sym := Line_Length; | |
804 | end if; | |
805 | ||
806 | Ptr := End_Sym + 1; | |
807 | ||
808 | declare | |
809 | Sym : constant String := Line_Buffer (Start_Sym .. End_Sym); | |
810 | ||
811 | begin | |
812 | if Matching_Strings (Sym, "not") then | |
813 | return K_Not; | |
814 | ||
815 | elsif Matching_Strings (Sym, "then") then | |
816 | return K_Then; | |
817 | ||
818 | elsif Matching_Strings (Sym, "if") then | |
819 | return K_If; | |
820 | ||
821 | elsif Matching_Strings (Sym, "else") then | |
822 | return K_Else; | |
823 | ||
824 | elsif Matching_Strings (Sym, "end") then | |
825 | return K_End; | |
826 | ||
827 | elsif Matching_Strings (Sym, "elsif") then | |
828 | return K_Elsif; | |
829 | ||
830 | elsif Matching_Strings (Sym, "and") then | |
831 | if Scan_Keyword = K_Then then | |
832 | Start_Sym := Kptr; | |
833 | return K_Andthen; | |
834 | else | |
835 | Ptr := Start_Sym; -- Put back the last keyword read | |
836 | Start_Sym := Kptr; | |
837 | return K_And; | |
838 | end if; | |
839 | ||
840 | elsif Matching_Strings (Sym, "or") then | |
841 | if Scan_Keyword = K_Else then | |
842 | Start_Sym := Kptr; | |
843 | return K_Orelse; | |
844 | else | |
845 | Ptr := Start_Sym; -- Put back the last keyword read | |
846 | Start_Sym := Kptr; | |
847 | return K_Or; | |
848 | end if; | |
849 | ||
850 | elsif Matching_Strings (Sym, "'defined") then | |
851 | return K_Defined; | |
852 | ||
07fc65c4 GB |
853 | elsif Matching_Strings (Sym, "include") then |
854 | return K_Include; | |
855 | ||
38cbfe40 RK |
856 | elsif Sym = "(" then |
857 | return K_Open_Paren; | |
858 | ||
859 | elsif Sym = ")" then | |
860 | return K_Close_Paren; | |
861 | ||
862 | elsif Sym = "=" then | |
863 | return K_Equal; | |
864 | end if; | |
865 | end; | |
866 | end if; | |
867 | ||
868 | Ptr := Kptr; | |
869 | return K_None; | |
870 | end Scan_Keyword; | |
871 | ||
872 | ----------------- | |
873 | -- Skip_Spaces -- | |
874 | ----------------- | |
875 | ||
876 | procedure Skip_Spaces is | |
877 | begin | |
878 | while Ptr <= Line_Length loop | |
879 | if Line_Buffer (Ptr) /= ' ' | |
880 | and then Line_Buffer (Ptr) /= ASCII.HT | |
881 | then | |
882 | return; | |
883 | else | |
884 | Ptr := Ptr + 1; | |
885 | end if; | |
886 | end loop; | |
887 | end Skip_Spaces; | |
888 | ||
889 | -------------------- | |
890 | -- Symbol_Scanned -- | |
891 | -------------------- | |
892 | ||
893 | function Symbol_Scanned return Boolean is | |
894 | begin | |
895 | End_Sym := Start_Sym - 1; | |
896 | ||
897 | case Line_Buffer (End_Sym + 1) is | |
898 | ||
899 | when '(' | ')' | '=' => | |
900 | End_Sym := End_Sym + 1; | |
901 | return True; | |
902 | ||
903 | when '"' => | |
904 | End_Sym := End_Sym + 1; | |
905 | while End_Sym < Line_Length loop | |
906 | ||
907 | if Line_Buffer (End_Sym + 1) = '"' then | |
908 | ||
909 | if End_Sym + 2 < Line_Length | |
910 | and then Line_Buffer (End_Sym + 2) = '"' | |
911 | then | |
912 | End_Sym := End_Sym + 2; | |
913 | else | |
914 | exit; | |
915 | end if; | |
916 | else | |
917 | End_Sym := End_Sym + 1; | |
918 | end if; | |
919 | end loop; | |
920 | ||
921 | if End_Sym >= Line_Length then | |
922 | Error ("Invalid string "); | |
923 | raise Expression_Error; | |
924 | end if; | |
925 | ||
926 | End_Sym := End_Sym + 1; | |
927 | return False; | |
928 | ||
929 | when ''' => | |
930 | End_Sym := End_Sym + 1; | |
931 | ||
932 | when others => | |
933 | null; | |
934 | end case; | |
935 | ||
936 | while End_Sym < Line_Length | |
937 | and then (Is_Alphanumeric (Line_Buffer (End_Sym + 1)) | |
938 | or else Line_Buffer (End_Sym + 1) = '_') | |
939 | loop | |
940 | End_Sym := End_Sym + 1; | |
941 | end loop; | |
942 | ||
943 | return OK_Identifier (Line_Buffer (Start_Sym .. End_Sym)); | |
944 | end Symbol_Scanned; | |
945 | ||
946 | -------------------- | |
947 | -- Variable_Index -- | |
948 | -------------------- | |
949 | ||
950 | function Variable_Index (Name : String) return Natural is | |
951 | begin | |
952 | for J in 1 .. Num_Syms loop | |
953 | if Matching_Strings (Symbols (J).all, Name) then | |
954 | return J; | |
955 | end if; | |
956 | end loop; | |
957 | ||
958 | return Natural'Last; | |
959 | end Variable_Index; | |
960 | ||
961 | -- Start of processing for GNATprep | |
962 | ||
963 | begin | |
964 | ||
965 | -- Parse the switches | |
966 | ||
967 | loop | |
968 | case GNAT.Command_Line.Getopt ("D: b c r s u") is | |
969 | when ASCII.NUL => | |
970 | exit; | |
971 | ||
972 | when 'D' => | |
973 | declare | |
974 | S : String := GNAT.Command_Line.Parameter; | |
975 | Index : Natural; | |
976 | ||
977 | begin | |
978 | Index := Ada.Strings.Fixed.Index (S, "="); | |
979 | ||
980 | if Index = 0 then | |
981 | Num_Syms := Num_Syms + 1; | |
982 | Symbols (Num_Syms) := new String'(S); | |
983 | Values (Num_Syms) := new String'("True"); | |
984 | ||
985 | else | |
986 | Num_Syms := Num_Syms + 1; | |
987 | Symbols (Num_Syms) := new String'(S (S'First .. Index - 1)); | |
988 | Values (Num_Syms) := new String'(S (Index + 1 .. S'Last)); | |
989 | end if; | |
990 | end; | |
991 | ||
992 | when 'b' => | |
993 | Blank_Deleted_Lines := True; | |
994 | ||
995 | when 'c' => | |
996 | Opt_Comment_Deleted_Lines := True; | |
997 | ||
998 | when 'r' => | |
999 | Source_Ref_Pragma := True; | |
1000 | ||
1001 | when 's' => | |
1002 | List_Symbols := True; | |
1003 | ||
1004 | when 'u' => | |
1005 | Undefined_Is_False := True; | |
1006 | ||
1007 | when others => | |
1008 | raise Usage_Error; | |
1009 | end case; | |
1010 | end loop; | |
1011 | ||
1012 | -- Get the file names | |
1013 | ||
1014 | loop | |
1015 | declare | |
1016 | S : constant String := GNAT.Command_Line.Get_Argument; | |
1017 | ||
1018 | begin | |
1019 | exit when S'Length = 0; | |
1020 | ||
07fc65c4 GB |
1021 | if Infile.Name = null then |
1022 | Infile.Name := new String'(S); | |
38cbfe40 RK |
1023 | elsif Outfile_Name = null then |
1024 | Outfile_Name := new String'(S); | |
1025 | elsif Deffile_Name = null then | |
1026 | Deffile_Name := new String'(S); | |
1027 | else | |
1028 | raise Usage_Error; | |
1029 | end if; | |
1030 | end; | |
1031 | end loop; | |
1032 | ||
1033 | -- Test we had all the arguments needed | |
1034 | ||
07fc65c4 | 1035 | if Infile.Name = null |
38cbfe40 RK |
1036 | or else Outfile_Name = null |
1037 | then | |
1038 | raise Usage_Error; | |
1039 | end if; | |
1040 | ||
1041 | if Source_Ref_Pragma and (not Opt_Comment_Deleted_Lines) then | |
1042 | Blank_Deleted_Lines := True; | |
1043 | end if; | |
1044 | ||
1045 | -- Get symbol definitions | |
1046 | ||
1047 | if Deffile_Name /= null then | |
1048 | Parse_Def_File; | |
1049 | end if; | |
1050 | ||
1051 | if Num_Errors > 0 then | |
1052 | raise Fatal_Error; | |
1053 | ||
1054 | elsif List_Symbols and then Num_Syms > 0 then | |
1055 | List_Symbols_Case : declare | |
1056 | ||
1057 | function Lt (Op1, Op2 : Natural) return Boolean; | |
1058 | -- Comparison routine for sort call | |
1059 | ||
1060 | procedure Move (From : Natural; To : Natural); | |
1061 | -- Move routine for sort call | |
1062 | ||
1063 | function Lt (Op1, Op2 : Natural) return Boolean is | |
1064 | L1 : constant Natural := Symbols (Op1)'Length; | |
1065 | L2 : constant Natural := Symbols (Op2)'Length; | |
1066 | MinL : constant Natural := Natural'Min (L1, L2); | |
1067 | ||
1068 | C1, C2 : Character; | |
1069 | ||
1070 | begin | |
1071 | for J in 0 .. MinL - 1 loop | |
1072 | C1 := To_Upper (Symbols (Op1).all (Symbols (Op1)'First + J)); | |
1073 | C2 := To_Upper (Symbols (Op2).all (Symbols (Op2)'First + J)); | |
1074 | ||
1075 | if C1 < C2 then | |
1076 | return True; | |
1077 | ||
1078 | elsif C1 > C2 then | |
1079 | return False; | |
1080 | end if; | |
1081 | end loop; | |
1082 | ||
1083 | return L1 < L2; | |
1084 | end Lt; | |
1085 | ||
1086 | procedure Move (From : Natural; To : Natural) is | |
1087 | begin | |
1088 | Symbols (To) := Symbols (From); | |
1089 | Values (To) := Values (From); | |
1090 | end Move; | |
1091 | ||
1092 | package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt); | |
1093 | ||
1094 | Max_L : Natural; | |
1095 | -- Maximum length of any symbol | |
1096 | ||
1097 | -- Start of processing for List_Symbols_Case | |
1098 | ||
1099 | begin | |
1100 | Sort_Syms.Sort (Num_Syms); | |
1101 | ||
1102 | Max_L := 7; | |
1103 | for J in 1 .. Num_Syms loop | |
1104 | Max_L := Natural'Max (Max_L, Symbols (J)'Length); | |
1105 | end loop; | |
1106 | ||
1107 | New_Line; | |
1108 | Put ("Symbol"); | |
1109 | ||
1110 | for J in 1 .. Max_L - 5 loop | |
1111 | Put (' '); | |
1112 | end loop; | |
1113 | ||
1114 | Put_Line ("Value"); | |
1115 | ||
1116 | Put ("------"); | |
1117 | ||
1118 | for J in 1 .. Max_L - 5 loop | |
1119 | Put (' '); | |
1120 | end loop; | |
1121 | ||
1122 | Put_Line ("------"); | |
1123 | ||
1124 | for J in 1 .. Num_Syms loop | |
1125 | Put (Symbols (J).all); | |
1126 | ||
1127 | for K in 1 .. Max_L - Symbols (J)'Length + 1 loop | |
1128 | Put (' '); | |
1129 | end loop; | |
1130 | ||
1131 | Put_Line (Values (J).all); | |
1132 | end loop; | |
1133 | ||
1134 | New_Line; | |
1135 | end List_Symbols_Case; | |
1136 | end if; | |
1137 | ||
1138 | -- Open files and initialize preprocessing | |
1139 | ||
1140 | begin | |
07fc65c4 | 1141 | Open (Infile.File, In_File, Infile.Name.all); |
38cbfe40 RK |
1142 | |
1143 | exception | |
1144 | when Name_Error => | |
07fc65c4 | 1145 | Put_Line (Standard_Error, "cannot open " & Infile.Name.all); |
38cbfe40 RK |
1146 | raise Fatal_Error; |
1147 | end; | |
1148 | ||
1149 | begin | |
1150 | Create (Outfile, Out_File, Outfile_Name.all); | |
1151 | ||
1152 | exception | |
1153 | when Name_Error => | |
1154 | Put_Line (Standard_Error, "cannot create " & Outfile_Name.all); | |
1155 | raise Fatal_Error; | |
1156 | end; | |
1157 | ||
07fc65c4 GB |
1158 | Infile.Line_Num := 0; |
1159 | Current_File_Name := Infile.Name; | |
38cbfe40 RK |
1160 | |
1161 | PP_Depth := 0; | |
1162 | PP (0).Deleting := False; | |
1163 | ||
07fc65c4 GB |
1164 | -- We return here after we start reading an include file and after |
1165 | -- we have finished reading an include file. | |
1166 | ||
1167 | <<Read_In_File>> | |
1168 | ||
1169 | -- If we generate Source_Reference pragmas, then generate one | |
1170 | -- either with line number 1 for a newly included file, or | |
1171 | -- with the number of the next line when we have returned to the | |
1172 | -- including file. | |
1173 | ||
1174 | if Source_Ref_Pragma then | |
1175 | Put_Line | |
1176 | (Outfile, "pragma Source_Reference (" & | |
1177 | Image (Infile.Line_Num + 1) & | |
1178 | ", """ & Infile.Name.all & """);"); | |
1179 | end if; | |
1180 | ||
38cbfe40 RK |
1181 | -- Loop through lines in input file |
1182 | ||
07fc65c4 GB |
1183 | while not End_Of_File (Infile.File) loop |
1184 | Get_Line (Infile.File, Line_Buffer, Line_Length); | |
1185 | Infile.Line_Num := Infile.Line_Num + 1; | |
38cbfe40 RK |
1186 | |
1187 | -- Handle preprocessor line | |
1188 | ||
1189 | if Is_Preprocessor_Line then | |
1190 | K := Scan_Keyword; | |
1191 | ||
1192 | case K is | |
1193 | ||
07fc65c4 GB |
1194 | -- Include file |
1195 | ||
1196 | when K_Include => | |
1197 | -- Ignore if Deleting is True | |
1198 | ||
1199 | if PP (PP_Depth).Deleting then | |
1200 | goto Output; | |
1201 | end if; | |
1202 | ||
1203 | Skip_Spaces; | |
1204 | ||
1205 | if Ptr >= Line_Length then | |
1206 | Error ("no file to include"); | |
1207 | ||
1208 | elsif Line_Buffer (Ptr) /= '"' then | |
1209 | Error | |
1210 | ("file to include must be specified as a literal string"); | |
1211 | ||
1212 | else | |
1213 | declare | |
1214 | Start_File : constant Positive := Ptr + 1; | |
1215 | ||
1216 | begin | |
1217 | Ptr := Line_Length; | |
1218 | ||
1219 | while Line_Buffer (Ptr) = ' ' | |
1220 | or else Line_Buffer (Ptr) = ASCII.HT | |
1221 | loop | |
1222 | Ptr := Ptr - 1; | |
1223 | end loop; | |
1224 | ||
1225 | if Ptr <= Start_File | |
1226 | or else Line_Buffer (Ptr) /= '"' | |
1227 | then | |
1228 | Error ("no string literal for included file"); | |
1229 | ||
1230 | else | |
1231 | if Infile.Next = null then | |
1232 | Infile.Next := new Input; | |
1233 | Infile.Next.Prev := Infile; | |
1234 | end if; | |
1235 | ||
1236 | Infile := Infile.Next; | |
1237 | Infile.Name := | |
1238 | new String'(Line_Buffer (Start_File .. Ptr - 1)); | |
1239 | ||
1240 | -- Check for circularity: an file including itself, | |
1241 | -- either directly or indirectly. | |
1242 | ||
1243 | declare | |
1244 | File : Input_Ptr := Infile.Prev; | |
1245 | ||
1246 | begin | |
1247 | while File /= null | |
1248 | and then File.Name.all /= Infile.Name.all | |
1249 | loop | |
1250 | File := File.Prev; | |
1251 | end loop; | |
1252 | ||
1253 | if File /= null then | |
1254 | Infile := Infile.Prev; | |
1255 | Error ("circularity in included files"); | |
1256 | ||
1257 | while File.Prev /= null loop | |
1258 | File := File.Prev; | |
1259 | end loop; | |
1260 | ||
1261 | while File /= Infile.Next loop | |
1262 | Error ('"' & File.Name.all & | |
1263 | """ includes """ & | |
1264 | File.Next.Name.all & '"'); | |
1265 | File := File.Next; | |
1266 | end loop; | |
1267 | ||
1268 | else | |
1269 | -- We have a file name and no circularity. | |
1270 | -- Open the file and record an error if the | |
1271 | -- file cannot be opened. | |
1272 | ||
1273 | begin | |
1274 | Open (Infile.File, In_File, Infile.Name.all); | |
1275 | Current_File_Name := Infile.Name; | |
1276 | Infile.Line_Num := 0; | |
1277 | ||
1278 | -- If we use Source_Reference pragma, | |
1279 | -- we need to output one for this new file. | |
1280 | goto Read_In_File; | |
1281 | ||
1282 | exception | |
1283 | when Name_Error => | |
1284 | ||
1285 | -- We need to set the input file to | |
1286 | -- the including file, so that the | |
1287 | -- line number is correct when reporting | |
1288 | -- the error. | |
1289 | ||
1290 | Infile := Infile.Prev; | |
1291 | Error ("cannot open """ & | |
1292 | Infile.Next.Name.all & '"'); | |
1293 | end; | |
1294 | end if; | |
1295 | end; | |
1296 | end if; | |
1297 | end; | |
1298 | end if; | |
1299 | ||
38cbfe40 RK |
1300 | -- If/Elsif processing |
1301 | ||
1302 | when K_If | K_Elsif => | |
1303 | ||
1304 | -- If differs from elsif only in that an initial stack entry | |
1305 | -- must be made for the new if range. We set the match seen | |
1306 | -- entry to a copy of the deleting status in the range above | |
1307 | -- us. If we are deleting in the range above us, then we want | |
1308 | -- all the branches of the nested #if to delete. | |
1309 | ||
1310 | if K = K_If then | |
1311 | PP_Depth := PP_Depth + 1; | |
1312 | PP (PP_Depth) := | |
07fc65c4 GB |
1313 | (If_Line => Infile.Line_Num, |
1314 | If_Name => Infile.Name, | |
38cbfe40 RK |
1315 | Else_Line => 0, |
1316 | Deleting => False, | |
1317 | Match_Seen => PP (PP_Depth - 1).Deleting); | |
1318 | ||
1319 | elsif PP_Depth = 0 then | |
1320 | Error ("no matching #if for this #elsif"); | |
1321 | goto Output; | |
1322 | ||
1323 | end if; | |
1324 | ||
1325 | PP (PP_Depth).Deleting := True; | |
1326 | ||
1327 | if not PP (PP_Depth).Match_Seen | |
1328 | and then Eval_Condition = True | |
1329 | then | |
1330 | ||
1331 | -- Case of match and no match yet in this #if | |
1332 | ||
1333 | PP (PP_Depth).Deleting := False; | |
1334 | PP (PP_Depth).Match_Seen := True; | |
1335 | No_Junk; | |
1336 | end if; | |
1337 | ||
1338 | -- Processing for #else | |
1339 | ||
1340 | when K_Else => | |
1341 | ||
1342 | if PP_Depth = 0 then | |
1343 | Error ("no matching #if for this #else"); | |
1344 | ||
1345 | elsif PP (PP_Depth).Else_Line /= 0 then | |
1346 | Error ("duplicate #else line (previous was on line" & | |
1347 | Natural'Image (PP (PP_Depth).Else_Line) & | |
1348 | ")"); | |
1349 | ||
1350 | else | |
07fc65c4 | 1351 | PP (PP_Depth).Else_Line := Infile.Line_Num; |
38cbfe40 RK |
1352 | PP (PP_Depth).Deleting := PP (PP_Depth).Match_Seen; |
1353 | end if; | |
1354 | ||
1355 | No_Junk; | |
1356 | ||
1357 | -- Process for #end | |
1358 | ||
1359 | when K_End => | |
1360 | ||
1361 | if PP_Depth = 0 then | |
1362 | Error ("no matching #if for this #end"); | |
1363 | ||
1364 | else | |
1365 | Skip_Spaces; | |
1366 | ||
1367 | if Scan_Keyword /= K_If then | |
1368 | Error ("expected if after #end"); | |
1369 | Ptr := Line_Length + 1; | |
1370 | end if; | |
1371 | ||
1372 | Skip_Spaces; | |
1373 | ||
1374 | if Ptr > Line_Length | |
1375 | or else Line_Buffer (Ptr) /= ';' | |
1376 | then | |
1377 | Error ("missing semicolon after #end if"); | |
1378 | else | |
1379 | Ptr := Ptr + 1; | |
1380 | end if; | |
1381 | ||
1382 | No_Junk; | |
1383 | ||
1384 | PP_Depth := PP_Depth - 1; | |
1385 | end if; | |
1386 | ||
1387 | when others => | |
1388 | Error ("invalid preprocessor keyword syntax"); | |
1389 | ||
1390 | end case; | |
1391 | ||
1392 | -- Handle symbol substitution | |
1393 | ||
1394 | -- Substitution is not allowed in string (which we simply skip), | |
1395 | -- but is allowed inside character constants. The last case is | |
1396 | -- because there is no way to know whether the user want to | |
1397 | -- substitute the name of an attribute ('Min or 'Max for instance) | |
1398 | -- or actually meant to substitue a character ('$name' is probably | |
1399 | -- a character constant, but my_type'$name'Min is probably an | |
1400 | -- attribute, with $name=Base) | |
1401 | ||
1402 | else | |
1403 | Ptr := 1; | |
1404 | ||
1405 | while Ptr < Line_Length loop | |
1406 | exit when At_End_Of_Line; | |
1407 | ||
1408 | case Line_Buffer (Ptr) is | |
1409 | ||
1410 | when ''' => | |
1411 | ||
1412 | -- Two special cases here: | |
1413 | -- '"' => we don't want the " sign to appear as belonging | |
1414 | -- to a string. | |
1415 | -- '$' => this is obviously not a substitution, just skip it | |
1416 | ||
1417 | if Ptr < Line_Length - 1 | |
1418 | and then Line_Buffer (Ptr + 1) = '"' | |
1419 | then | |
1420 | Ptr := Ptr + 2; | |
1421 | elsif Ptr < Line_Length - 2 | |
1422 | and then Line_Buffer (Ptr + 1 .. Ptr + 2) = "$'" | |
1423 | then | |
1424 | Ptr := Ptr + 2; | |
1425 | end if; | |
1426 | ||
1427 | when '"' => | |
1428 | ||
1429 | -- The special case of "" inside the string is easy to | |
1430 | -- handle: just ignore them. The second one will be seen | |
1431 | -- as the beginning of a second string | |
1432 | ||
1433 | Ptr := Ptr + 1; | |
1434 | while Ptr < Line_Length | |
1435 | and then Line_Buffer (Ptr) /= '"' | |
1436 | loop | |
1437 | Ptr := Ptr + 1; | |
1438 | end loop; | |
1439 | ||
1440 | when '$' => | |
1441 | ||
1442 | -- $ found, so scan out possible following symbol | |
1443 | ||
1444 | Start_Sym := Ptr + 1; | |
1445 | ||
1446 | if Symbol_Scanned then | |
1447 | ||
1448 | -- Look up symbol in table and if found do replacement | |
1449 | ||
1450 | for J in 1 .. Num_Syms loop | |
1451 | if Matching_Strings | |
1452 | (Symbols (J).all, Line_Buffer (Start_Sym .. End_Sym)) | |
1453 | then | |
1454 | declare | |
1455 | OldL : constant Positive := | |
1456 | End_Sym - Start_Sym + 2; | |
1457 | NewL : constant Positive := Values (J)'Length; | |
1458 | AdjL : constant Integer := NewL - OldL; | |
1459 | NewP : constant Positive := Ptr + NewL - 1; | |
1460 | ||
1461 | begin | |
1462 | Line_Buffer (NewP + 1 .. Line_Length + AdjL) := | |
1463 | Line_Buffer (End_Sym + 1 .. Line_Length); | |
1464 | Line_Buffer (Ptr .. NewP) := Values (J).all; | |
1465 | ||
1466 | Ptr := NewP; | |
1467 | Line_Length := Line_Length + AdjL; | |
1468 | end; | |
1469 | ||
1470 | exit; | |
1471 | end if; | |
1472 | end loop; | |
1473 | end if; | |
1474 | ||
1475 | when others => | |
1476 | null; | |
1477 | ||
1478 | end case; | |
1479 | Ptr := Ptr + 1; | |
1480 | end loop; | |
1481 | end if; | |
1482 | ||
1483 | -- Here after dealing with preprocessor line, output current line | |
1484 | ||
1485 | <<Output>> | |
1486 | ||
1487 | if Is_Preprocessor_Line or else PP (PP_Depth).Deleting then | |
1488 | if Blank_Deleted_Lines then | |
1489 | New_Line (Outfile); | |
1490 | ||
1491 | elsif Opt_Comment_Deleted_Lines then | |
1492 | if Line_Length = 0 then | |
1493 | Put_Line (Outfile, "--!"); | |
1494 | else | |
1495 | Put (Outfile, "--! "); | |
1496 | Put_Line (Outfile, Line_Buffer (1 .. Line_Length)); | |
1497 | end if; | |
1498 | end if; | |
1499 | ||
1500 | else | |
1501 | Put_Line (Outfile, Line_Buffer (1 .. Line_Length)); | |
1502 | end if; | |
1503 | end loop; | |
1504 | ||
07fc65c4 GB |
1505 | -- If we have finished reading an included file, close it and continue |
1506 | -- with the next line of the including file. | |
1507 | ||
1508 | if Infile.Prev /= null then | |
1509 | Close (Infile.File); | |
1510 | Infile := Infile.Prev; | |
1511 | Current_File_Name := Infile.Name; | |
1512 | goto Read_In_File; | |
1513 | end if; | |
1514 | ||
38cbfe40 | 1515 | for J in 1 .. PP_Depth loop |
07fc65c4 GB |
1516 | if PP (J).If_Name = Infile.Name then |
1517 | Error ("no matching #end for #if at line" & | |
1518 | Natural'Image (PP (J).If_Line)); | |
1519 | else | |
1520 | Error ("no matching #end for #if at line" & | |
1521 | Natural'Image (PP (J).If_Line) & | |
1522 | " of file """ & PP (J).If_Name.all & '"'); | |
1523 | end if; | |
38cbfe40 RK |
1524 | end loop; |
1525 | ||
1526 | if Num_Errors = 0 then | |
1527 | Close (Outfile); | |
1528 | Set_Exit_Status (0); | |
1529 | else | |
1530 | Delete (Outfile); | |
1531 | Set_Exit_Status (1); | |
1532 | end if; | |
1533 | ||
1534 | exception | |
1535 | when Usage_Error => | |
1536 | Help_Page; | |
1537 | Set_Exit_Status (1); | |
1538 | ||
1539 | when GNAT.Command_Line.Invalid_Parameter => | |
1540 | Put_Line (Standard_Error, "No parameter given for -" | |
1541 | & GNAT.Command_Line.Full_Switch); | |
1542 | Help_Page; | |
1543 | Set_Exit_Status (1); | |
1544 | ||
1545 | when GNAT.Command_Line.Invalid_Switch => | |
1546 | Put_Line (Standard_Error, "Invalid Switch: -" | |
1547 | & GNAT.Command_Line.Full_Switch); | |
1548 | Help_Page; | |
1549 | Set_Exit_Status (1); | |
1550 | ||
1551 | when Fatal_Error => | |
1552 | Set_Exit_Status (1); | |
1553 | ||
1554 | when Expression_Error => | |
1555 | Set_Exit_Status (1); | |
1556 | ||
1557 | end GNATprep; |