c-family/
[official-gcc.git] / gcc / ada / prepcomp.adb
blobdd64bcb714b2329aa13752d3d2d359f29f9b0da9
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R E P C O M P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2003-2012, Free Software Foundation, Inc. --
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 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
26 with Errout; use Errout;
27 with Lib.Writ; use Lib.Writ;
28 with Opt; use Opt;
29 with Osint; use Osint;
30 with Prep; use Prep;
31 with Scans; use Scans;
32 with Scn; use Scn;
33 with Sinput.L; use Sinput.L;
34 with Stringt; use Stringt;
35 with Table;
36 with Types; use Types;
38 package body Prepcomp is
40 No_Preprocessing : Boolean := True;
41 -- Set to False if there is at least one source that needs to be
42 -- preprocessed.
44 Source_Index_Of_Preproc_Data_File : Source_File_Index := No_Source_File;
46 -- The following variable should be a constant, but this is not possible
47 -- because its type GNAT.Dynamic_Tables.Instance has a component P of
48 -- uninitialized private type GNAT.Dynamic_Tables.Table_Private and there
49 -- are no exported values for this private type. Warnings are Off because
50 -- it is never assigned a value.
52 pragma Warnings (Off);
53 No_Mapping : Prep.Symbol_Table.Instance;
54 pragma Warnings (On);
56 type Preproc_Data is record
57 Mapping : Symbol_Table.Instance;
58 File_Name : File_Name_Type := No_File;
59 Deffile : String_Id := No_String;
60 Undef_False : Boolean := False;
61 Always_Blank : Boolean := False;
62 Comments : Boolean := False;
63 No_Deletion : Boolean := False;
64 List_Symbols : Boolean := False;
65 Processed : Boolean := False;
66 end record;
67 -- Structure to keep the preprocessing data for a file name or for the
68 -- default (when Name_Id = No_Name).
70 No_Preproc_Data : constant Preproc_Data :=
71 (Mapping => No_Mapping,
72 File_Name => No_File,
73 Deffile => No_String,
74 Undef_False => False,
75 Always_Blank => False,
76 Comments => False,
77 No_Deletion => False,
78 List_Symbols => False,
79 Processed => False);
81 Default_Data : Preproc_Data := No_Preproc_Data;
82 -- The preprocessing data to be used when no specific preprocessing data
83 -- is specified for a source.
85 Default_Data_Defined : Boolean := False;
86 -- True if source for which no specific preprocessing is specified need to
87 -- be preprocess with the Default_Data.
89 Current_Data : Preproc_Data := No_Preproc_Data;
91 package Preproc_Data_Table is new Table.Table
92 (Table_Component_Type => Preproc_Data,
93 Table_Index_Type => Int,
94 Table_Low_Bound => 1,
95 Table_Initial => 5,
96 Table_Increment => 100,
97 Table_Name => "Prepcomp.Preproc_Data_Table");
98 -- Table to store the specific preprocessing data
100 Command_Line_Symbols : Symbol_Table.Instance;
101 -- A table to store symbol definitions specified on the command line with
102 -- -gnateD switches.
104 package Dependencies is new Table.Table
105 (Table_Component_Type => Source_File_Index,
106 Table_Index_Type => Int,
107 Table_Low_Bound => 1,
108 Table_Initial => 10,
109 Table_Increment => 100,
110 Table_Name => "Prepcomp.Dependencies");
111 -- Table to store the dependencies on preprocessing files
113 procedure Add_Command_Line_Symbols;
114 -- Add the command line symbol definitions, if any, to Prep.Mapping table
116 procedure Skip_To_End_Of_Line;
117 -- Ignore errors and scan up to the next end of line or the end of file
119 ------------------------------
120 -- Add_Command_Line_Symbols --
121 ------------------------------
123 procedure Add_Command_Line_Symbols is
124 Symbol_Id : Prep.Symbol_Id;
126 begin
127 for J in 1 .. Symbol_Table.Last (Command_Line_Symbols) loop
128 Symbol_Id := Prep.Index_Of (Command_Line_Symbols.Table (J).Symbol);
130 if Symbol_Id = No_Symbol then
131 Symbol_Table.Increment_Last (Prep.Mapping);
132 Symbol_Id := Symbol_Table.Last (Prep.Mapping);
133 end if;
135 Prep.Mapping.Table (Symbol_Id) := Command_Line_Symbols.Table (J);
136 end loop;
137 end Add_Command_Line_Symbols;
139 ----------------------
140 -- Add_Dependencies --
141 ----------------------
143 procedure Add_Dependencies is
144 begin
145 for Index in 1 .. Dependencies.Last loop
146 Add_Preprocessing_Dependency (Dependencies.Table (Index));
147 end loop;
148 end Add_Dependencies;
150 -------------------
151 -- Check_Symbols --
152 -------------------
154 procedure Check_Symbols is
155 begin
156 -- If there is at least one switch -gnateD specified
158 if Symbol_Table.Last (Command_Line_Symbols) >= 1 then
159 Current_Data := No_Preproc_Data;
160 No_Preprocessing := False;
161 Current_Data.Processed := True;
163 -- Start with an empty, initialized mapping table; use Prep.Mapping,
164 -- because Prep.Index_Of uses Prep.Mapping.
166 Prep.Mapping := No_Mapping;
167 Symbol_Table.Init (Prep.Mapping);
169 -- Add the command line symbols
171 Add_Command_Line_Symbols;
173 -- Put the resulting Prep.Mapping in Current_Data, and immediately
174 -- set Prep.Mapping to nil.
176 Current_Data.Mapping := Prep.Mapping;
177 Prep.Mapping := No_Mapping;
179 -- Set the default data
181 Default_Data := Current_Data;
182 Default_Data_Defined := True;
183 end if;
184 end Check_Symbols;
186 ------------------------------
187 -- Parse_Preprocessing_Data --
188 ------------------------------
190 procedure Parse_Preprocessing_Data_File (N : File_Name_Type) is
191 OK : Boolean := False;
192 Dash_Location : Source_Ptr;
193 Symbol_Data : Prep.Symbol_Data;
194 Symbol_Id : Prep.Symbol_Id;
195 T : constant Nat := Total_Errors_Detected;
197 begin
198 -- Load the preprocessing data file
200 Source_Index_Of_Preproc_Data_File := Load_Preprocessing_Data_File (N);
202 -- Fail if preprocessing data file cannot be found
204 if Source_Index_Of_Preproc_Data_File = No_Source_File then
205 Get_Name_String (N);
206 Fail ("preprocessing data file """
207 & Name_Buffer (1 .. Name_Len)
208 & """ not found");
209 end if;
211 -- Initialize scanner and set its behavior for processing a data file
213 Scn.Scanner.Initialize_Scanner (Source_Index_Of_Preproc_Data_File);
214 Scn.Scanner.Set_End_Of_Line_As_Token (True);
215 Scn.Scanner.Reset_Special_Characters;
217 For_Each_Line : loop
218 <<Scan_Line>>
219 Scan;
221 exit For_Each_Line when Token = Tok_EOF;
223 if Token = Tok_End_Of_Line then
224 goto Scan_Line;
225 end if;
227 -- Line is not empty
229 OK := False;
230 No_Preprocessing := False;
231 Current_Data := No_Preproc_Data;
233 case Token is
234 when Tok_Asterisk =>
236 -- Default data
238 if Default_Data_Defined then
239 Error_Msg
240 ("multiple default preprocessing data", Token_Ptr);
242 else
243 OK := True;
244 Default_Data_Defined := True;
245 end if;
247 when Tok_String_Literal =>
249 -- Specific data
251 String_To_Name_Buffer (String_Literal_Id);
252 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
253 Current_Data.File_Name := Name_Find;
254 OK := True;
256 for Index in 1 .. Preproc_Data_Table.Last loop
257 if Current_Data.File_Name =
258 Preproc_Data_Table.Table (Index).File_Name
259 then
260 Error_Msg_File_1 := Current_Data.File_Name;
261 Error_Msg
262 ("multiple preprocessing data for{", Token_Ptr);
263 OK := False;
264 exit;
265 end if;
266 end loop;
268 when others =>
269 Error_Msg ("`'*` or literal string expected", Token_Ptr);
270 end case;
272 -- If there is a problem, skip the line
274 if not OK then
275 Skip_To_End_Of_Line;
276 goto Scan_Line;
277 end if;
279 -- Scan past the * or the literal string
281 Scan;
283 -- A literal string in second position is a definition file
285 if Token = Tok_String_Literal then
286 Current_Data.Deffile := String_Literal_Id;
287 Current_Data.Processed := False;
288 Scan;
290 else
291 -- If there is no definition file, set Processed to True now
293 Current_Data.Processed := True;
294 end if;
296 -- Start with an empty, initialized mapping table; use Prep.Mapping,
297 -- because Prep.Index_Of uses Prep.Mapping.
299 Prep.Mapping := No_Mapping;
300 Symbol_Table.Init (Prep.Mapping);
302 -- Check the switches that may follow
304 while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
305 if Token /= Tok_Minus then
306 Error_Msg -- CODEFIX
307 ("`'-` expected", Token_Ptr);
308 Skip_To_End_Of_Line;
309 goto Scan_Line;
310 end if;
312 -- Keep the location of the '-' for possible error reporting
314 Dash_Location := Token_Ptr;
316 -- Scan past the '-'
318 Scan;
319 OK := False;
320 Change_Reserved_Keyword_To_Symbol;
322 -- An identifier (or a reserved word converted to an
323 -- identifier) is expected and there must be no blank space
324 -- between the '-' and the identifier.
326 if Token = Tok_Identifier
327 and then Token_Ptr = Dash_Location + 1
328 then
329 Get_Name_String (Token_Name);
331 -- Check the character in the source, because the case is
332 -- significant.
334 case Sinput.Source (Token_Ptr) is
335 when 'a' =>
337 -- All source text preserved (also implies -u)
339 if Name_Len = 1 then
340 Current_Data.No_Deletion := True;
341 Current_Data.Undef_False := True;
342 OK := True;
343 end if;
345 when 'u' =>
347 -- Undefined symbol are False
349 if Name_Len = 1 then
350 Current_Data.Undef_False := True;
351 OK := True;
352 end if;
354 when 'b' =>
356 -- Blank lines
358 if Name_Len = 1 then
359 Current_Data.Always_Blank := True;
360 OK := True;
361 end if;
363 when 'c' =>
365 -- Comment removed lines
367 if Name_Len = 1 then
368 Current_Data.Comments := True;
369 OK := True;
370 end if;
372 when 's' =>
374 -- List symbols
376 if Name_Len = 1 then
377 Current_Data.List_Symbols := True;
378 OK := True;
379 end if;
381 when 'D' =>
383 -- Symbol definition
385 OK := Name_Len > 1;
387 if OK then
389 -- A symbol must be an Ada identifier; it cannot start
390 -- with an underline or a digit.
392 if Name_Buffer (2) = '_'
393 or else Name_Buffer (2) in '0' .. '9'
394 then
395 Error_Msg ("symbol expected", Token_Ptr + 1);
396 Skip_To_End_Of_Line;
397 goto Scan_Line;
398 end if;
400 -- Get the name id of the symbol
402 Symbol_Data.On_The_Command_Line := True;
403 Name_Buffer (1 .. Name_Len - 1) :=
404 Name_Buffer (2 .. Name_Len);
405 Name_Len := Name_Len - 1;
406 Symbol_Data.Symbol := Name_Find;
408 if Name_Buffer (1 .. Name_Len) = "if"
409 or else Name_Buffer (1 .. Name_Len) = "else"
410 or else Name_Buffer (1 .. Name_Len) = "elsif"
411 or else Name_Buffer (1 .. Name_Len) = "end"
412 or else Name_Buffer (1 .. Name_Len) = "not"
413 or else Name_Buffer (1 .. Name_Len) = "and"
414 or else Name_Buffer (1 .. Name_Len) = "then"
415 then
416 Error_Msg ("symbol expected", Token_Ptr + 1);
417 Skip_To_End_Of_Line;
418 goto Scan_Line;
419 end if;
421 -- Get the name id of the original symbol, with
422 -- possibly capital letters.
424 Name_Len := Integer (Scan_Ptr - Token_Ptr - 1);
426 for J in 1 .. Name_Len loop
427 Name_Buffer (J) :=
428 Sinput.Source (Token_Ptr + Text_Ptr (J));
429 end loop;
431 Symbol_Data.Original := Name_Find;
433 -- Scan past D<symbol>
435 Scan;
437 if Token /= Tok_Equal then
438 Error_Msg -- CODEFIX
439 ("`=` expected", Token_Ptr);
440 Skip_To_End_Of_Line;
441 goto Scan_Line;
442 end if;
444 -- Scan past '='
446 Scan;
448 -- Here any reserved word is OK
450 Change_Reserved_Keyword_To_Symbol
451 (All_Keywords => True);
453 -- Value can be an identifier (or a reserved word)
454 -- or a literal string.
456 case Token is
457 when Tok_String_Literal =>
458 Symbol_Data.Is_A_String := True;
459 Symbol_Data.Value := String_Literal_Id;
461 when Tok_Identifier =>
462 Symbol_Data.Is_A_String := False;
463 Start_String;
465 for J in Token_Ptr .. Scan_Ptr - 1 loop
466 Store_String_Char (Sinput.Source (J));
467 end loop;
469 Symbol_Data.Value := End_String;
471 when others =>
472 Error_Msg
473 ("literal string or identifier expected",
474 Token_Ptr);
475 Skip_To_End_Of_Line;
476 goto Scan_Line;
477 end case;
479 -- If symbol already exists, replace old definition
480 -- by new one.
482 Symbol_Id := Prep.Index_Of (Symbol_Data.Symbol);
484 -- Otherwise, add a new entry in the table
486 if Symbol_Id = No_Symbol then
487 Symbol_Table.Increment_Last (Prep.Mapping);
488 Symbol_Id := Symbol_Table.Last (Mapping);
489 end if;
491 Prep.Mapping.Table (Symbol_Id) := Symbol_Data;
492 end if;
494 when others =>
495 null;
496 end case;
498 Scan;
499 end if;
501 if not OK then
502 Error_Msg ("invalid switch", Dash_Location);
503 Skip_To_End_Of_Line;
504 goto Scan_Line;
505 end if;
506 end loop;
508 -- Add the command line symbols, if any, possibly replacing symbols
509 -- just defined.
511 Add_Command_Line_Symbols;
513 -- Put the resulting Prep.Mapping in Current_Data, and immediately
514 -- set Prep.Mapping to nil.
516 Current_Data.Mapping := Prep.Mapping;
517 Prep.Mapping := No_Mapping;
519 -- Record Current_Data
521 if Current_Data.File_Name = No_File then
522 Default_Data := Current_Data;
524 else
525 Preproc_Data_Table.Increment_Last;
526 Preproc_Data_Table.Table (Preproc_Data_Table.Last) := Current_Data;
527 end if;
529 Current_Data := No_Preproc_Data;
530 end loop For_Each_Line;
532 Scn.Scanner.Set_End_Of_Line_As_Token (False);
534 -- Fail if there were errors in the preprocessing data file
536 if Total_Errors_Detected > T then
537 Errout.Finalize (Last_Call => True);
538 Errout.Output_Messages;
539 Fail ("errors found in preprocessing data file """
540 & Get_Name_String (N) & """");
541 end if;
543 -- Record the dependency on the preprocessor data file
545 Dependencies.Increment_Last;
546 Dependencies.Table (Dependencies.Last) :=
547 Source_Index_Of_Preproc_Data_File;
548 end Parse_Preprocessing_Data_File;
550 ---------------------------
551 -- Prepare_To_Preprocess --
552 ---------------------------
554 procedure Prepare_To_Preprocess
555 (Source : File_Name_Type;
556 Preprocessing_Needed : out Boolean)
558 Default : Boolean := False;
559 Index : Int := 0;
561 begin
562 -- By default, preprocessing is not needed
564 Preprocessing_Needed := False;
566 if No_Preprocessing then
567 return;
568 end if;
570 -- First, look for preprocessing data specific to the current source
572 for J in 1 .. Preproc_Data_Table.Last loop
573 if Preproc_Data_Table.Table (J).File_Name = Source then
574 Index := J;
575 Current_Data := Preproc_Data_Table.Table (J);
576 exit;
577 end if;
578 end loop;
580 -- If no specific preprocessing data, then take the default
582 if Index = 0 then
583 if Default_Data_Defined then
584 Current_Data := Default_Data;
585 Default := True;
587 else
588 -- If no default, then nothing to do
590 return;
591 end if;
592 end if;
594 -- Set the preprocessing flags according to the preprocessing data
596 if Current_Data.Comments and not Current_Data.Always_Blank then
597 Comment_Deleted_Lines := True;
598 Blank_Deleted_Lines := False;
599 else
600 Comment_Deleted_Lines := False;
601 Blank_Deleted_Lines := True;
602 end if;
604 No_Deletion := Current_Data.No_Deletion;
605 Undefined_Symbols_Are_False := Current_Data.Undef_False;
606 List_Preprocessing_Symbols := Current_Data.List_Symbols;
608 -- If not already done it, process the definition file
610 if Current_Data.Processed then
612 -- Set Prep.Mapping
614 Prep.Mapping := Current_Data.Mapping;
616 else
617 -- First put the mapping in Prep.Mapping, because Prep.Parse_Def_File
618 -- works on Prep.Mapping.
620 Prep.Mapping := Current_Data.Mapping;
622 String_To_Name_Buffer (Current_Data.Deffile);
624 declare
625 N : constant File_Name_Type := Name_Find;
626 Deffile : constant Source_File_Index :=
627 Load_Definition_File (N);
628 Add_Deffile : Boolean := True;
629 T : constant Nat := Total_Errors_Detected;
631 begin
632 if Deffile = No_Source_File then
633 Fail ("definition file """
634 & Get_Name_String (N)
635 & """ not found");
636 end if;
638 -- Initialize the preprocessor and set the characteristics of the
639 -- scanner for a definition file.
641 Prep.Setup_Hooks
642 (Error_Msg => Errout.Error_Msg'Access,
643 Scan => Scn.Scanner.Scan'Access,
644 Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
645 Put_Char => null,
646 New_EOL => null);
648 Scn.Scanner.Set_End_Of_Line_As_Token (True);
649 Scn.Scanner.Reset_Special_Characters;
651 -- Initialize the scanner and process the definition file
653 Scn.Scanner.Initialize_Scanner (Deffile);
654 Prep.Parse_Def_File;
656 -- Reset the behaviour of the scanner to the default
658 Scn.Scanner.Set_End_Of_Line_As_Token (False);
660 -- Fail if errors were found while processing the definition file
662 if T /= Total_Errors_Detected then
663 Errout.Finalize (Last_Call => True);
664 Errout.Output_Messages;
665 Fail ("errors found in definition file """
666 & Get_Name_String (N)
667 & """");
668 end if;
670 for Index in 1 .. Dependencies.Last loop
671 if Dependencies.Table (Index) = Deffile then
672 Add_Deffile := False;
673 exit;
674 end if;
675 end loop;
677 if Add_Deffile then
678 Dependencies.Increment_Last;
679 Dependencies.Table (Dependencies.Last) := Deffile;
680 end if;
681 end;
683 -- Get back the mapping, indicate that the definition file is
684 -- processed and store back the preprocessing data.
686 Current_Data.Mapping := Prep.Mapping;
687 Current_Data.Processed := True;
689 if Default then
690 Default_Data := Current_Data;
692 else
693 Preproc_Data_Table.Table (Index) := Current_Data;
694 end if;
695 end if;
697 Preprocessing_Needed := True;
698 end Prepare_To_Preprocess;
700 ---------------------------------------------
701 -- Process_Command_Line_Symbol_Definitions --
702 ---------------------------------------------
704 procedure Process_Command_Line_Symbol_Definitions is
705 Symbol_Data : Prep.Symbol_Data;
706 Found : Boolean := False;
708 begin
709 Symbol_Table.Init (Command_Line_Symbols);
711 -- The command line definitions have been stored temporarily in
712 -- array Symbol_Definitions.
714 for Index in 1 .. Preprocessing_Symbol_Last loop
715 -- Check each symbol definition, fail immediately if syntax is not
716 -- correct.
718 Check_Command_Line_Symbol_Definition
719 (Definition => Preprocessing_Symbol_Defs (Index).all,
720 Data => Symbol_Data);
721 Found := False;
723 -- If there is already a definition for this symbol, replace the old
724 -- definition by this one.
726 for J in 1 .. Symbol_Table.Last (Command_Line_Symbols) loop
727 if Command_Line_Symbols.Table (J).Symbol = Symbol_Data.Symbol then
728 Command_Line_Symbols.Table (J) := Symbol_Data;
729 Found := True;
730 exit;
731 end if;
732 end loop;
734 -- Otherwise, create a new entry in the table
736 if not Found then
737 Symbol_Table.Increment_Last (Command_Line_Symbols);
738 Command_Line_Symbols.Table
739 (Symbol_Table.Last (Command_Line_Symbols)) := Symbol_Data;
740 end if;
741 end loop;
742 end Process_Command_Line_Symbol_Definitions;
744 -------------------------
745 -- Skip_To_End_Of_Line --
746 -------------------------
748 procedure Skip_To_End_Of_Line is
749 begin
750 Set_Ignore_Errors (To => True);
752 while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
753 Scan;
754 end loop;
756 Set_Ignore_Errors (To => False);
757 end Skip_To_End_Of_Line;
759 end Prepcomp;