1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2003-2020, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
27 with Errout
; use Errout
;
28 with Lib
.Writ
; use Lib
.Writ
;
30 with Osint
; use Osint
;
32 with Scans
; use Scans
;
34 with Sinput
.L
; use Sinput
.L
;
35 with Stringt
; use Stringt
;
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
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
;
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;
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
,
75 Always_Blank
=> False,
78 List_Symbols
=> 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
,
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
104 package Dependencies
is new Table
.Table
105 (Table_Component_Type
=> Source_File_Index
,
106 Table_Index_Type
=> Int
,
107 Table_Low_Bound
=> 1,
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
;
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
);
135 Prep
.Mapping
.Table
(Symbol_Id
) := Command_Line_Symbols
.Table
(J
);
137 end Add_Command_Line_Symbols
;
143 procedure Add_Dependency
(S
: Source_File_Index
) is
145 Dependencies
.Increment_Last
;
146 Dependencies
.Table
(Dependencies
.Last
) := S
;
149 ----------------------
150 -- Add_Dependencies --
151 ----------------------
153 procedure Add_Dependencies
is
155 for Index
in 1 .. Dependencies
.Last
loop
156 Add_Preprocessing_Dependency
(Dependencies
.Table
(Index
));
158 end Add_Dependencies
;
164 procedure Check_Symbols
is
166 -- If there is at least one switch -gnateD specified
168 if Symbol_Table
.Last
(Command_Line_Symbols
) >= 1 then
169 Current_Data
:= No_Preproc_Data
;
170 No_Preprocessing
:= False;
171 Current_Data
.Processed
:= True;
173 -- Start with an empty, initialized mapping table; use Prep.Mapping,
174 -- because Prep.Index_Of uses Prep.Mapping.
176 Prep
.Mapping
:= No_Mapping
;
177 Symbol_Table
.Init
(Prep
.Mapping
);
179 -- Add the command line symbols
181 Add_Command_Line_Symbols
;
183 -- Put the resulting Prep.Mapping in Current_Data, and immediately
184 -- set Prep.Mapping to nil.
186 Current_Data
.Mapping
:= Prep
.Mapping
;
187 Prep
.Mapping
:= No_Mapping
;
189 -- Set the default data
191 Default_Data
:= Current_Data
;
192 Default_Data_Defined
:= True;
196 -----------------------------------
197 -- Parse_Preprocessing_Data_File --
198 -----------------------------------
200 procedure Parse_Preprocessing_Data_File
(N
: File_Name_Type
) is
201 OK
: Boolean := False;
202 Dash_Location
: Source_Ptr
;
203 Symbol_Data
: Prep
.Symbol_Data
;
204 Symbol_Id
: Prep
.Symbol_Id
;
205 T
: constant Nat
:= Total_Errors_Detected
;
208 -- Load the preprocessing data file
210 Source_Index_Of_Preproc_Data_File
:= Load_Preprocessing_Data_File
(N
);
212 -- Fail if preprocessing data file cannot be found
214 if Source_Index_Of_Preproc_Data_File
= No_Source_File
then
216 Fail
("preprocessing data file """
217 & Name_Buffer
(1 .. Name_Len
)
221 -- Initialize scanner and set its behavior for processing a data file
223 Scn
.Scanner
.Initialize_Scanner
(Source_Index_Of_Preproc_Data_File
);
224 Scn
.Scanner
.Set_End_Of_Line_As_Token
(True);
225 Scn
.Scanner
.Reset_Special_Characters
;
231 exit For_Each_Line
when Token
= Tok_EOF
;
233 if Token
= Tok_End_Of_Line
then
240 No_Preprocessing
:= False;
241 Current_Data
:= No_Preproc_Data
;
248 if Default_Data_Defined
then
250 ("multiple default preprocessing data", Token_Ptr
);
254 Default_Data_Defined
:= True;
257 when Tok_String_Literal
=>
261 String_To_Name_Buffer
(String_Literal_Id
);
262 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
263 Current_Data
.File_Name
:= Name_Find
;
266 for Index
in 1 .. Preproc_Data_Table
.Last
loop
267 if Current_Data
.File_Name
=
268 Preproc_Data_Table
.Table
(Index
).File_Name
270 Error_Msg_File_1
:= Current_Data
.File_Name
;
272 ("multiple preprocessing data for{", Token_Ptr
);
279 Error_Msg
("`'*` or literal string expected", Token_Ptr
);
282 -- If there is a problem, skip the line
289 -- Scan past the * or the literal string
293 -- A literal string in second position is a definition file
295 if Token
= Tok_String_Literal
then
296 Current_Data
.Deffile
:= String_Literal_Id
;
297 Current_Data
.Processed
:= False;
301 -- If there is no definition file, set Processed to True now
303 Current_Data
.Processed
:= True;
306 -- Start with an empty, initialized mapping table; use Prep.Mapping,
307 -- because Prep.Index_Of uses Prep.Mapping.
309 Prep
.Mapping
:= No_Mapping
;
310 Symbol_Table
.Init
(Prep
.Mapping
);
312 -- Check the switches that may follow
314 while Token
/= Tok_End_Of_Line
and then Token
/= Tok_EOF
loop
315 if Token
/= Tok_Minus
then
317 ("`'-` expected", Token_Ptr
);
322 -- Keep the location of the '-' for possible error reporting
324 Dash_Location
:= Token_Ptr
;
330 Change_Reserved_Keyword_To_Symbol
;
332 -- An identifier (or a reserved word converted to an
333 -- identifier) is expected and there must be no blank space
334 -- between the '-' and the identifier.
336 if Token
= Tok_Identifier
337 and then Token_Ptr
= Dash_Location
+ 1
339 Get_Name_String
(Token_Name
);
341 -- Check the character in the source, because the case is
344 case Sinput
.Source
(Token_Ptr
) is
347 -- All source text preserved (also implies -u)
350 Current_Data
.No_Deletion
:= True;
351 Current_Data
.Undef_False
:= True;
357 -- Undefined symbol are False
360 Current_Data
.Undef_False
:= True;
369 Current_Data
.Always_Blank
:= True;
375 -- Comment removed lines
378 Current_Data
.Comments
:= True;
387 Current_Data
.List_Symbols
:= True;
399 -- A symbol must be an Ada identifier; it cannot start
400 -- with an underline or a digit.
402 if Name_Buffer
(2) = '_'
403 or else Name_Buffer
(2) in '0' .. '9'
405 Error_Msg
("symbol expected", Token_Ptr
+ 1);
410 -- Get the name id of the symbol
412 Symbol_Data
.On_The_Command_Line
:= True;
413 Name_Buffer
(1 .. Name_Len
- 1) :=
414 Name_Buffer
(2 .. Name_Len
);
415 Name_Len
:= Name_Len
- 1;
416 Symbol_Data
.Symbol
:= Name_Find
;
418 if Name_Buffer
(1 .. Name_Len
) = "if"
419 or else Name_Buffer
(1 .. Name_Len
) = "else"
420 or else Name_Buffer
(1 .. Name_Len
) = "elsif"
421 or else Name_Buffer
(1 .. Name_Len
) = "end"
422 or else Name_Buffer
(1 .. Name_Len
) = "not"
423 or else Name_Buffer
(1 .. Name_Len
) = "and"
424 or else Name_Buffer
(1 .. Name_Len
) = "then"
426 Error_Msg
("symbol expected", Token_Ptr
+ 1);
431 -- Get the name id of the original symbol, with
432 -- possibly capital letters.
434 Name_Len
:= Integer (Scan_Ptr
- Token_Ptr
- 1);
436 for J
in 1 .. Name_Len
loop
438 Sinput
.Source
(Token_Ptr
+ Text_Ptr
(J
));
441 Symbol_Data
.Original
:= Name_Find
;
443 -- Scan past D<symbol>
447 if Token
/= Tok_Equal
then
449 ("`=` expected", Token_Ptr
);
458 -- Here any reserved word is OK
460 Change_Reserved_Keyword_To_Symbol
461 (All_Keywords
=> True);
463 -- Value can be an identifier (or a reserved word)
464 -- or a literal string.
467 when Tok_String_Literal
=>
468 Symbol_Data
.Is_A_String
:= True;
469 Symbol_Data
.Value
:= String_Literal_Id
;
471 when Tok_Identifier
=>
472 Symbol_Data
.Is_A_String
:= False;
475 for J
in Token_Ptr
.. Scan_Ptr
- 1 loop
476 Store_String_Char
(Sinput
.Source
(J
));
479 Symbol_Data
.Value
:= End_String
;
483 ("literal string or identifier expected",
489 -- If symbol already exists, replace old definition
492 Symbol_Id
:= Prep
.Index_Of
(Symbol_Data
.Symbol
);
494 -- Otherwise, add a new entry in the table
496 if Symbol_Id
= No_Symbol
then
497 Symbol_Table
.Increment_Last
(Prep
.Mapping
);
498 Symbol_Id
:= Symbol_Table
.Last
(Mapping
);
501 Prep
.Mapping
.Table
(Symbol_Id
) := Symbol_Data
;
512 Error_Msg
("invalid switch", Dash_Location
);
518 -- Add the command line symbols, if any, possibly replacing symbols
521 Add_Command_Line_Symbols
;
523 -- Put the resulting Prep.Mapping in Current_Data, and immediately
524 -- set Prep.Mapping to nil.
526 Current_Data
.Mapping
:= Prep
.Mapping
;
527 Prep
.Mapping
:= No_Mapping
;
529 -- Record Current_Data
531 if Current_Data
.File_Name
= No_File
then
532 Default_Data
:= Current_Data
;
535 Preproc_Data_Table
.Increment_Last
;
536 Preproc_Data_Table
.Table
(Preproc_Data_Table
.Last
) := Current_Data
;
539 Current_Data
:= No_Preproc_Data
;
540 end loop For_Each_Line
;
542 Scn
.Scanner
.Set_End_Of_Line_As_Token
(False);
544 -- Fail if there were errors in the preprocessing data file
546 if Total_Errors_Detected
> T
then
547 Errout
.Finalize
(Last_Call
=> True);
548 Errout
.Output_Messages
;
549 Fail
("errors found in preprocessing data file """
550 & Get_Name_String
(N
) & """");
553 -- Record the dependency on the preprocessor data file
555 Add_Dependency
(Source_Index_Of_Preproc_Data_File
);
556 end Parse_Preprocessing_Data_File
;
558 ---------------------------
559 -- Prepare_To_Preprocess --
560 ---------------------------
562 procedure Prepare_To_Preprocess
563 (Source
: File_Name_Type
;
564 Preprocessing_Needed
: out Boolean)
566 Default
: Boolean := False;
570 -- By default, preprocessing is not needed
572 Preprocessing_Needed
:= False;
574 if No_Preprocessing
then
578 -- First, look for preprocessing data specific to the current source
580 for J
in 1 .. Preproc_Data_Table
.Last
loop
581 if Preproc_Data_Table
.Table
(J
).File_Name
= Source
then
583 Current_Data
:= Preproc_Data_Table
.Table
(J
);
588 -- If no specific preprocessing data, then take the default
591 if Default_Data_Defined
then
592 Current_Data
:= Default_Data
;
596 -- If no default, then nothing to do
602 -- Set the preprocessing flags according to the preprocessing data
604 if Current_Data
.Comments
and not Current_Data
.Always_Blank
then
605 Comment_Deleted_Lines
:= True;
606 Blank_Deleted_Lines
:= False;
608 Comment_Deleted_Lines
:= False;
609 Blank_Deleted_Lines
:= True;
612 No_Deletion
:= Current_Data
.No_Deletion
;
613 Undefined_Symbols_Are_False
:= Current_Data
.Undef_False
;
614 List_Preprocessing_Symbols
:= Current_Data
.List_Symbols
;
616 -- If not already done it, process the definition file
618 if Current_Data
.Processed
then
622 Prep
.Mapping
:= Current_Data
.Mapping
;
625 -- First put the mapping in Prep.Mapping, because Prep.Parse_Def_File
626 -- works on Prep.Mapping.
628 Prep
.Mapping
:= Current_Data
.Mapping
;
630 String_To_Name_Buffer
(Current_Data
.Deffile
);
633 N
: constant File_Name_Type
:= Name_Find
;
634 Deffile
: constant Source_File_Index
:= Load_Definition_File
(N
);
635 T
: constant Nat
:= Total_Errors_Detected
;
637 Add_Deffile
: Boolean := True;
640 if Deffile
<= No_Source_File
then
642 ("definition file """ & Get_Name_String
(N
) & """ not found");
645 -- Initialize the preprocessor and set the characteristics of the
646 -- scanner for a definition file.
649 (Error_Msg
=> Errout
.Error_Msg
'Access,
650 Scan
=> Scn
.Scanner
.Scan
'Access,
651 Set_Ignore_Errors
=> Errout
.Set_Ignore_Errors
'Access,
655 Scn
.Scanner
.Set_End_Of_Line_As_Token
(True);
656 Scn
.Scanner
.Reset_Special_Characters
;
658 -- Initialize the scanner and process the definition file
660 Scn
.Scanner
.Initialize_Scanner
(Deffile
);
663 -- Reset the behavior of the scanner to the default
665 Scn
.Scanner
.Set_End_Of_Line_As_Token
(False);
667 -- Fail if errors were found while processing the definition file
669 if T
/= Total_Errors_Detected
then
670 Errout
.Finalize
(Last_Call
=> True);
671 Errout
.Output_Messages
;
672 Fail
("errors found in definition file """
673 & Get_Name_String
(N
)
677 for Index
in 1 .. Dependencies
.Last
loop
678 if Dependencies
.Table
(Index
) = Deffile
then
679 Add_Deffile
:= False;
685 Add_Dependency
(Deffile
);
689 -- Get back the mapping, indicate that the definition file is
690 -- processed and store back the preprocessing data.
692 Current_Data
.Mapping
:= Prep
.Mapping
;
693 Current_Data
.Processed
:= True;
696 Default_Data
:= Current_Data
;
699 Preproc_Data_Table
.Table
(Index
) := Current_Data
;
703 Preprocessing_Needed
:= True;
704 end Prepare_To_Preprocess
;
706 ---------------------------------------------
707 -- Process_Command_Line_Symbol_Definitions --
708 ---------------------------------------------
710 procedure Process_Command_Line_Symbol_Definitions
is
711 Symbol_Data
: Prep
.Symbol_Data
;
712 Found
: Boolean := False;
715 Symbol_Table
.Init
(Command_Line_Symbols
);
717 -- The command line definitions have been stored temporarily in
718 -- array Symbol_Definitions.
720 for Index
in 1 .. Preprocessing_Symbol_Last
loop
721 -- Check each symbol definition, fail immediately if syntax is not
724 Check_Command_Line_Symbol_Definition
725 (Definition
=> Preprocessing_Symbol_Defs
(Index
).all,
726 Data
=> Symbol_Data
);
729 -- If there is already a definition for this symbol, replace the old
730 -- definition by this one.
732 for J
in 1 .. Symbol_Table
.Last
(Command_Line_Symbols
) loop
733 if Command_Line_Symbols
.Table
(J
).Symbol
= Symbol_Data
.Symbol
then
734 Command_Line_Symbols
.Table
(J
) := Symbol_Data
;
740 -- Otherwise, create a new entry in the table
743 Symbol_Table
.Increment_Last
(Command_Line_Symbols
);
744 Command_Line_Symbols
.Table
745 (Symbol_Table
.Last
(Command_Line_Symbols
)) := Symbol_Data
;
748 end Process_Command_Line_Symbol_Definitions
;
750 -------------------------
751 -- Skip_To_End_Of_Line --
752 -------------------------
754 procedure Skip_To_End_Of_Line
is
756 Set_Ignore_Errors
(To
=> True);
758 while Token
/= Tok_End_Of_Line
and then Token
/= Tok_EOF
loop
762 Set_Ignore_Errors
(To
=> False);
763 end Skip_To_End_Of_Line
;