1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2003-2012, 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 Errout
; use Errout
;
27 with Lib
.Writ
; use Lib
.Writ
;
29 with Osint
; use Osint
;
31 with Scans
; use Scans
;
33 with Sinput
.L
; use Sinput
.L
;
34 with Stringt
; use Stringt
;
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
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
;
139 ----------------------
140 -- Add_Dependencies --
141 ----------------------
143 procedure Add_Dependencies
is
145 for Index
in 1 .. Dependencies
.Last
loop
146 Add_Preprocessing_Dependency
(Dependencies
.Table
(Index
));
148 end Add_Dependencies
;
154 procedure Check_Symbols
is
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;
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
;
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
206 Fail
("preprocessing data file """
207 & Name_Buffer
(1 .. Name_Len
)
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
;
221 exit For_Each_Line
when Token
= Tok_EOF
;
223 if Token
= Tok_End_Of_Line
then
230 No_Preprocessing
:= False;
231 Current_Data
:= No_Preproc_Data
;
238 if Default_Data_Defined
then
240 ("multiple default preprocessing data", Token_Ptr
);
244 Default_Data_Defined
:= True;
247 when Tok_String_Literal
=>
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
;
256 for Index
in 1 .. Preproc_Data_Table
.Last
loop
257 if Current_Data
.File_Name
=
258 Preproc_Data_Table
.Table
(Index
).File_Name
260 Error_Msg_File_1
:= Current_Data
.File_Name
;
262 ("multiple preprocessing data for{", Token_Ptr
);
269 Error_Msg
("`'*` or literal string expected", Token_Ptr
);
272 -- If there is a problem, skip the line
279 -- Scan past the * or the literal string
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;
291 -- If there is no definition file, set Processed to True now
293 Current_Data
.Processed
:= True;
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
307 ("`'-` expected", Token_Ptr
);
312 -- Keep the location of the '-' for possible error reporting
314 Dash_Location
:= Token_Ptr
;
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
329 Get_Name_String
(Token_Name
);
331 -- Check the character in the source, because the case is
334 case Sinput
.Source
(Token_Ptr
) is
337 -- All source text preserved (also implies -u)
340 Current_Data
.No_Deletion
:= True;
341 Current_Data
.Undef_False
:= True;
347 -- Undefined symbol are False
350 Current_Data
.Undef_False
:= True;
359 Current_Data
.Always_Blank
:= True;
365 -- Comment removed lines
368 Current_Data
.Comments
:= True;
377 Current_Data
.List_Symbols
:= True;
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'
395 Error_Msg
("symbol expected", Token_Ptr
+ 1);
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"
416 Error_Msg
("symbol expected", Token_Ptr
+ 1);
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
428 Sinput
.Source
(Token_Ptr
+ Text_Ptr
(J
));
431 Symbol_Data
.Original
:= Name_Find
;
433 -- Scan past D<symbol>
437 if Token
/= Tok_Equal
then
439 ("`=` expected", Token_Ptr
);
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.
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;
465 for J
in Token_Ptr
.. Scan_Ptr
- 1 loop
466 Store_String_Char
(Sinput
.Source
(J
));
469 Symbol_Data
.Value
:= End_String
;
473 ("literal string or identifier expected",
479 -- If symbol already exists, replace old definition
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
);
491 Prep
.Mapping
.Table
(Symbol_Id
) := Symbol_Data
;
502 Error_Msg
("invalid switch", Dash_Location
);
508 -- Add the command line symbols, if any, possibly replacing symbols
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
;
525 Preproc_Data_Table
.Increment_Last
;
526 Preproc_Data_Table
.Table
(Preproc_Data_Table
.Last
) := Current_Data
;
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
) & """");
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;
562 -- By default, preprocessing is not needed
564 Preprocessing_Needed
:= False;
566 if No_Preprocessing
then
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
575 Current_Data
:= Preproc_Data_Table
.Table
(J
);
580 -- If no specific preprocessing data, then take the default
583 if Default_Data_Defined
then
584 Current_Data
:= Default_Data
;
588 -- If no default, then nothing to do
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;
600 Comment_Deleted_Lines
:= False;
601 Blank_Deleted_Lines
:= True;
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
614 Prep
.Mapping
:= Current_Data
.Mapping
;
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
);
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
;
632 if Deffile
= No_Source_File
then
633 Fail
("definition file """
634 & Get_Name_String
(N
)
638 -- Initialize the preprocessor and set the characteristics of the
639 -- scanner for a definition file.
642 (Error_Msg
=> Errout
.Error_Msg
'Access,
643 Scan
=> Scn
.Scanner
.Scan
'Access,
644 Set_Ignore_Errors
=> Errout
.Set_Ignore_Errors
'Access,
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
);
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
)
670 for Index
in 1 .. Dependencies
.Last
loop
671 if Dependencies
.Table
(Index
) = Deffile
then
672 Add_Deffile
:= False;
678 Dependencies
.Increment_Last
;
679 Dependencies
.Table
(Dependencies
.Last
) := Deffile
;
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;
690 Default_Data
:= Current_Data
;
693 Preproc_Data_Table
.Table
(Index
) := Current_Data
;
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;
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
718 Check_Command_Line_Symbol_Definition
719 (Definition
=> Preprocessing_Symbol_Defs
(Index
).all,
720 Data
=> Symbol_Data
);
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
;
734 -- Otherwise, create a new entry in the table
737 Symbol_Table
.Increment_Last
(Command_Line_Symbols
);
738 Command_Line_Symbols
.Table
739 (Symbol_Table
.Last
(Command_Line_Symbols
)) := Symbol_Data
;
742 end Process_Command_Line_Symbol_Definitions
;
744 -------------------------
745 -- Skip_To_End_Of_Line --
746 -------------------------
748 procedure Skip_To_End_Of_Line
is
750 Set_Ignore_Errors
(To
=> True);
752 while Token
/= Tok_End_Of_Line
and then Token
/= Tok_EOF
loop
756 Set_Ignore_Errors
(To
=> False);
757 end Skip_To_End_Of_Line
;