1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2004, 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 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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
28 with Err_Vars
; use Err_Vars
;
31 with Namet
; use Namet
;
33 with Osint
; use Osint
;
34 with Output
; use Output
;
39 with Stringt
; use Stringt
;
40 with Types
; use Types
;
42 with Ada
.Text_IO
; use Ada
.Text_IO
;
43 with GNAT
.Case_Util
; use GNAT
.Case_Util
;
44 with GNAT
.Command_Line
;
45 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
46 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
50 Copyright_Displayed
: Boolean := False;
51 -- Used to prevent multiple displays of the copyright notice
53 ------------------------
54 -- Argument Line Data --
55 ------------------------
57 Infile_Name
: Name_Id
:= No_Name
;
58 Outfile_Name
: Name_Id
:= No_Name
;
59 Deffile_Name
: Name_Id
:= No_Name
;
61 Output_Directory
: Name_Id
:= No_Name
;
62 -- Used when the specified output is an existing directory
64 Input_Directory
: Name_Id
:= No_Name
;
65 -- Used when the specified input and output are existing directories
67 Source_Ref_Pragma
: Boolean := False;
68 -- Record command line options (set if -r switch set)
70 Text_Outfile
: aliased Ada
.Text_IO
.File_Type
;
71 Outfile
: constant File_Access
:= Text_Outfile
'Access;
73 File_Name_Buffer_Initial_Size
: constant := 50;
74 File_Name_Buffer
: String_Access
:=
75 new String (1 .. File_Name_Buffer_Initial_Size
);
76 -- A buffer to build output file names from input file names.
82 procedure Display_Copyright
;
83 -- Display the copyright notice
85 procedure Obsolescent_Check
(S
: Source_Ptr
);
86 -- Null procedure, needed by instantiation of Scng below
89 -- Null procedure, needed by instantiation of Scng below
91 package Scanner
is new Scng
99 -- The scanner for the preprocessor
101 function Is_ASCII_Letter
(C
: Character) return Boolean;
102 -- True if C is in 'a' .. 'z' or in 'A' .. 'Z'
104 procedure Double_File_Name_Buffer
;
105 -- Double the size of the file name buffer.
107 procedure Preprocess_Infile_Name
;
108 -- When the specified output is a directory, preprocess the infile name
109 -- for symbol substitution, to get the output file name.
111 procedure Process_Files
;
112 -- Process the single input file or all the files in the directory tree
113 -- rooted at the input directory.
115 procedure Process_Command_Line_Symbol_Definition
(S
: String);
116 -- Process a -D switch on the command line
118 procedure Put_Char_To_Outfile
(C
: Character);
119 -- Output one character to the output file.
120 -- Used to initialize the preprocessor.
122 procedure New_EOL_To_Outfile
;
123 -- Output a new line to the output file.
124 -- Used to initialize the preprocessor.
126 procedure Scan_Command_Line
;
127 -- Scan the switches and the file names
132 -----------------------
133 -- Display_Copyright --
134 -----------------------
136 procedure Display_Copyright
is
138 if not Copyright_Displayed
then
139 Write_Line
("GNAT Preprocessor " & Gnatvsn
.Gnat_Version_String
);
140 Write_Line
("Copyright 1996-2004 Free Software Foundation, Inc.");
141 Copyright_Displayed
:= True;
143 end Display_Copyright
;
145 -----------------------------
146 -- Double_File_Name_Buffer --
147 -----------------------------
149 procedure Double_File_Name_Buffer
is
150 New_Buffer
: constant String_Access
:=
151 new String (1 .. 2 * File_Name_Buffer
'Length);
153 New_Buffer
(File_Name_Buffer
'Range) := File_Name_Buffer
.all;
154 Free
(File_Name_Buffer
);
155 File_Name_Buffer
:= New_Buffer
;
156 end Double_File_Name_Buffer
;
162 procedure Gnatprep
is
164 -- Do some initializations (order is important here!)
171 -- Initialize the preprocessor
174 (Error_Msg
=> Errutil
.Error_Msg
'Access,
175 Scan
=> Scanner
.Scan
'Access,
176 Set_Ignore_Errors
=> Errutil
.Set_Ignore_Errors
'Access,
177 Put_Char
=> Put_Char_To_Outfile
'Access,
178 New_EOL
=> New_EOL_To_Outfile
'Access);
180 -- Set the scanner characteristics for the preprocessor
182 Scanner
.Set_Special_Character
('#');
183 Scanner
.Set_Special_Character
('$');
184 Scanner
.Set_End_Of_Line_As_Token
(True);
186 -- Initialize the mapping table of symbols to values
188 Prep
.Symbol_Table
.Init
(Prep
.Mapping
);
190 -- Parse the switches and arguments
194 if Opt
.Verbose_Mode
then
198 -- Test we had all the arguments needed
200 if Infile_Name
= No_Name
then
201 -- No input file specified, just output the usage and exit
206 elsif Outfile_Name
= No_Name
then
207 -- No output file specified, just output the usage and exit
213 -- If a pragma Source_File_Name, we need to keep line numbers.
214 -- So, if the deleted lines are not put as comment, we must output them
217 if Source_Ref_Pragma
and (not Opt
.Comment_Deleted_Lines
) then
218 Opt
.Blank_Deleted_Lines
:= True;
221 -- If we have a definition file, parse it
223 if Deffile_Name
/= No_Name
then
225 Deffile
: Source_File_Index
;
229 Deffile
:= Sinput
.C
.Load_File
(Get_Name_String
(Deffile_Name
));
231 -- Set Main_Source_File to the definition file for the benefit of
234 Sinput
.Main_Source_File
:= Deffile
;
236 if Deffile
= No_Source_File
then
237 Fail
("unable to find definition file """,
238 Get_Name_String
(Deffile_Name
),
242 Scanner
.Initialize_Scanner
(No_Unit
, Deffile
);
248 -- If there are errors in the definition file, output these errors
251 if Total_Errors_Detected
> 0 then
252 Errutil
.Finalize
(Source_Type
=> "definition");
253 Fail
("errors in definition file """,
254 Get_Name_String
(Deffile_Name
), """");
257 -- If -s switch was specified, print a sorted list of symbol names and
260 if Opt
.List_Preprocessing_Symbols
then
261 Prep
.List_Symbols
(Foreword
=> "");
264 Output_Directory
:= No_Name
;
265 Input_Directory
:= No_Name
;
267 -- Check if the specified output is an existing directory
269 if Is_Directory
(Get_Name_String
(Outfile_Name
)) then
270 Output_Directory
:= Outfile_Name
;
272 -- As the output is an existing directory, check if the input too
275 if Is_Directory
(Get_Name_String
(Infile_Name
)) then
276 Input_Directory
:= Infile_Name
;
280 -- And process the single input or the files in the directory tree
281 -- rooted at the input directory.
287 ---------------------
288 -- Is_ASCII_Letter --
289 ---------------------
291 function Is_ASCII_Letter
(C
: Character) return Boolean is
293 return C
in 'A' .. 'Z' or else C
in 'a' .. 'z';
296 ------------------------
297 -- New_EOL_To_Outfile --
298 ------------------------
300 procedure New_EOL_To_Outfile
is
302 New_Line
(Outfile
.all);
303 end New_EOL_To_Outfile
;
305 -----------------------
306 -- Obsolescent_Check --
307 -----------------------
309 procedure Obsolescent_Check
(S
: Source_Ptr
) is
310 pragma Warnings
(Off
, S
);
313 end Obsolescent_Check
;
320 procedure Post_Scan
is
325 ----------------------------
326 -- Preprocess_Infile_Name --
327 ----------------------------
329 procedure Preprocess_Infile_Name
is
331 First
: Positive := 1;
337 -- Initialize the buffer with the name of the input file
339 Get_Name_String
(Infile_Name
);
342 while File_Name_Buffer
'Length < Len
loop
343 Double_File_Name_Buffer
;
346 File_Name_Buffer
(1 .. Len
) := Name_Buffer
(1 .. Len
);
348 -- Look for possible symbols in the file name
350 while First
< Len
loop
352 -- A symbol starts with a dollar sign followed by a letter
354 if File_Name_Buffer
(First
) = '$' and then
355 Is_ASCII_Letter
(File_Name_Buffer
(First
+ 1))
359 -- Find the last letter of the symbol
361 while Last
< Len
and then
362 Is_ASCII_Letter
(File_Name_Buffer
(Last
+ 1))
367 -- Get the symbol name id
369 Name_Len
:= Last
- First
;
370 Name_Buffer
(1 .. Name_Len
) :=
371 File_Name_Buffer
(First
+ 1 .. Last
);
372 To_Lower
(Name_Buffer
(1 .. Name_Len
));
375 -- And look for this symbol name in the symbol table
377 for Index
in 1 .. Symbol_Table
.Last
(Mapping
) loop
378 Data
:= Mapping
.Table
(Index
);
380 if Data
.Symbol
= Symbol
then
382 -- We found the symbol. If its value is not a string,
383 -- replace the symbol in the file name with the value of
386 if not Data
.Is_A_String
then
387 String_To_Name_Buffer
(Data
.Value
);
390 Sym_Len
: constant Positive := Last
- First
+ 1;
391 Offset
: constant Integer := Name_Len
- Sym_Len
;
392 New_Len
: constant Natural := Len
+ Offset
;
395 while New_Len
> File_Name_Buffer
'Length loop
396 Double_File_Name_Buffer
;
399 File_Name_Buffer
(Last
+ 1 + Offset
.. New_Len
) :=
400 File_Name_Buffer
(Last
+ 1 .. Len
);
402 Last
:= Last
+ Offset
;
403 File_Name_Buffer
(First
.. Last
) :=
404 Name_Buffer
(1 .. Name_Len
);
412 -- Skip over the symbol name or its value: we are not checking
413 -- for another symbol name in the value.
422 -- We now have the output file name in the buffer. Get the output
423 -- path and put it in Outfile_Name.
425 Get_Name_String
(Output_Directory
);
426 Add_Char_To_Name_Buffer
(Directory_Separator
);
427 Add_Str_To_Name_Buffer
(File_Name_Buffer
(1 .. Len
));
428 Outfile_Name
:= Name_Find
;
429 end Preprocess_Infile_Name
;
431 --------------------------------------------
432 -- Process_Command_Line_Symbol_Definition --
433 --------------------------------------------
435 procedure Process_Command_Line_Symbol_Definition
(S
: String) is
440 -- Check the symbol definition and get the symbol and its value.
441 -- Fail if symbol definition is illegal.
443 Check_Command_Line_Symbol_Definition
(S
, Data
);
445 Symbol
:= Index_Of
(Data
.Symbol
);
447 -- If symbol does not alrady exist, create a new entry in the mapping
450 if Symbol
= No_Symbol
then
451 Symbol_Table
.Increment_Last
(Mapping
);
452 Symbol
:= Symbol_Table
.Last
(Mapping
);
455 Mapping
.Table
(Symbol
) := Data
;
456 end Process_Command_Line_Symbol_Definition
;
462 procedure Process_Files
is
464 procedure Process_One_File
;
465 -- Process input file Infile_Name and put the result in file
468 procedure Recursive_Process
(In_Dir
: String; Out_Dir
: String);
469 -- Process recursively files in In_Dir. Results go to Out_Dir.
471 ----------------------
472 -- Process_One_File --
473 ----------------------
475 procedure Process_One_File
is
476 Infile
: Source_File_Index
;
479 -- Create the output file; fails if this does not work.
482 Create
(Text_Outfile
, Out_File
, Get_Name_String
(Outfile_Name
));
487 ("unable to create output file """,
488 Get_Name_String
(Outfile_Name
), """");
491 -- Load the input file
493 Infile
:= Sinput
.C
.Load_File
(Get_Name_String
(Infile_Name
));
495 if Infile
= No_Source_File
then
496 Fail
("unable to find input file """,
497 Get_Name_String
(Infile_Name
), """");
500 -- Set Main_Source_File to the input file for the benefit of
503 Sinput
.Main_Source_File
:= Infile
;
505 Scanner
.Initialize_Scanner
(No_Unit
, Infile
);
507 -- Output the SFN pragma if asked to
509 if Source_Ref_Pragma
then
510 Put_Line
(Outfile
.all, "pragma Source_Reference (1, """ &
511 Get_Name_String
(Sinput
.File_Name
(Infile
)) &
515 -- Preprocess the input file
519 -- In verbose mode, if there is no error, report it
521 if Opt
.Verbose_Mode
and then Err_Vars
.Total_Errors_Detected
= 0 then
522 Errutil
.Finalize
(Source_Type
=> "input");
525 -- If we had some errors, delete the output file, and report
528 if Err_Vars
.Total_Errors_Detected
> 0 then
529 if Outfile
/= Standard_Output
then
530 Delete
(Text_Outfile
);
533 Errutil
.Finalize
(Source_Type
=> "input");
537 -- otherwise, close the output file, and we are done.
539 elsif Outfile
/= Standard_Output
then
540 Close
(Text_Outfile
);
542 end Process_One_File
;
544 -----------------------
545 -- Recursive_Process --
546 -----------------------
548 procedure Recursive_Process
(In_Dir
: String; Out_Dir
: String) is
550 Name
: String (1 .. 255);
552 In_Dir_Name
: Name_Id
;
553 Out_Dir_Name
: Name_Id
;
555 procedure Set_Directory_Names
;
556 -- Establish or reestablish the current input and output directories
558 -------------------------
559 -- Set_Directory_Names --
560 -------------------------
562 procedure Set_Directory_Names
is
564 Input_Directory
:= In_Dir_Name
;
565 Output_Directory
:= Out_Dir_Name
;
566 end Set_Directory_Names
;
569 -- Open the current input directory
572 Open
(Dir_In
, In_Dir
);
575 when Directory_Error
=>
576 Fail
("could not read directory " & In_Dir
);
579 -- Set the new input and output directory names
581 Name_Len
:= In_Dir
'Length;
582 Name_Buffer
(1 .. Name_Len
) := In_Dir
;
583 In_Dir_Name
:= Name_Find
;
584 Name_Len
:= Out_Dir
'Length;
585 Name_Buffer
(1 .. Name_Len
) := Out_Dir
;
586 Out_Dir_Name
:= Name_Find
;
590 -- Traverse the input directory
592 Read
(Dir_In
, Name
, Last
);
595 if Name
(1 .. Last
) /= "." and then Name
(1 .. Last
) /= ".." then
597 Input
: constant String :=
598 In_Dir
& Directory_Separator
& Name
(1 .. Last
);
599 Output
: constant String :=
600 Out_Dir
& Directory_Separator
& Name
(1 .. Last
);
603 -- If input is an ordinary file, process it
605 if Is_Regular_File
(Input
) then
606 -- First get the output file name
609 Name_Buffer
(1 .. Name_Len
) := Name
(1 .. Last
);
610 Infile_Name
:= Name_Find
;
611 Preprocess_Infile_Name
;
613 -- Set the input file name and process the file
615 Name_Len
:= Input
'Length;
616 Name_Buffer
(1 .. Name_Len
) := Input
;
617 Infile_Name
:= Name_Find
;
620 elsif Is_Directory
(Input
) then
621 -- Input is a directory. If the corresponding output
622 -- directory does not already exist, create it.
624 if not Is_Directory
(Output
) then
626 Make_Dir
(Dir_Name
=> Output
);
629 when Directory_Error
=>
630 Fail
("could not create directory """,
635 -- And process this new input directory
637 Recursive_Process
(Input
, Output
);
639 -- Reestablish the input and output directory names
640 -- that have been modified by the recursive call.
647 end Recursive_Process
;
650 if Output_Directory
= No_Name
then
651 -- If the output is not a directory, fail if the input is
652 -- an existing directory, to avoid possible problems.
654 if Is_Directory
(Get_Name_String
(Infile_Name
)) then
655 Fail
("input file """ & Get_Name_String
(Infile_Name
) &
656 """ is a directory");
659 -- Just process the single input file
663 elsif Input_Directory
= No_Name
then
664 -- Get the output file name from the input file name, and process
665 -- the single input file.
667 Preprocess_Infile_Name
;
671 -- Recursively process files in the directory tree rooted at the
675 (In_Dir
=> Get_Name_String
(Input_Directory
),
676 Out_Dir
=> Get_Name_String
(Output_Directory
));
680 -------------------------
681 -- Put_Char_To_Outfile --
682 -------------------------
684 procedure Put_Char_To_Outfile
(C
: Character) is
686 Put
(Outfile
.all, C
);
687 end Put_Char_To_Outfile
;
689 -----------------------
690 -- Scan_Command_Line --
691 -----------------------
693 procedure Scan_Command_Line
is
697 -- Parse the switches
701 Switch
:= GNAT
.Command_Line
.Getopt
("D: b c r s u v");
708 Process_Command_Line_Symbol_Definition
709 (S
=> GNAT
.Command_Line
.Parameter
);
712 Opt
.Blank_Deleted_Lines
:= True;
715 Opt
.Comment_Deleted_Lines
:= True;
718 Source_Ref_Pragma
:= True;
721 Opt
.List_Preprocessing_Symbols
:= True;
724 Opt
.Undefined_Symbols_Are_False
:= True;
727 Opt
.Verbose_Mode
:= True;
730 Fail
("Invalid Switch: -" & Switch
);
734 when GNAT
.Command_Line
.Invalid_Switch
=>
735 Write_Str
("Invalid Switch: -");
736 Write_Line
(GNAT
.Command_Line
.Full_Switch
);
742 -- Get the file names
746 S
: constant String := GNAT
.Command_Line
.Get_Argument
;
749 exit when S
'Length = 0;
751 Name_Len
:= S
'Length;
752 Name_Buffer
(1 .. Name_Len
) := S
;
754 if Infile_Name
= No_Name
then
755 Infile_Name
:= Name_Find
;
756 elsif Outfile_Name
= No_Name
then
757 Outfile_Name
:= Name_Find
;
758 elsif Deffile_Name
= No_Name
then
759 Deffile_Name
:= Name_Find
;
761 Fail
("too many arguments specifed");
765 end Scan_Command_Line
;
774 Write_Line
("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
775 "infile outfile [deffile]");
777 Write_Line
(" infile Name of the input file");
778 Write_Line
(" outfile Name of the output file");
779 Write_Line
(" deffile Name of the definition file");
781 Write_Line
("gnatprep switches:");
782 Write_Line
(" -b Replace preprocessor lines by blank lines");
783 Write_Line
(" -c Keep preprocessor lines as comments");
784 Write_Line
(" -D Associate symbol with value");
785 Write_Line
(" -r Generate Source_Reference pragma");
786 Write_Line
(" -s Print a sorted list of symbol names and values");
787 Write_Line
(" -u Treat undefined symbols as FALSE");
788 Write_Line
(" -v Verbose mode");