* builtins.def (BUILT_IN_STACK_ALLOC): Remove.
[official-gcc.git] / gcc / ada / gprep.adb
blobfdd1f8ba25bba0463583aeb431ebf7649baae908
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G P R E P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2004, 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 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. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
27 with Csets;
28 with Err_Vars; use Err_Vars;
29 with Errutil;
30 with Gnatvsn;
31 with Namet; use Namet;
32 with Opt;
33 with Osint; use Osint;
34 with Output; use Output;
35 with Prep; use Prep;
36 with Scng;
37 with Sinput.C;
38 with Snames;
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;
49 package body GPrep is
51 Copyright_Displayed : Boolean := False;
52 -- Used to prevent multiple displays of the copyright notice
54 ------------------------
55 -- Argument Line Data --
56 ------------------------
58 Infile_Name : Name_Id := No_Name;
59 Outfile_Name : Name_Id := No_Name;
60 Deffile_Name : Name_Id := No_Name;
62 Output_Directory : Name_Id := No_Name;
63 -- Used when the specified output is an existing directory
65 Input_Directory : Name_Id := No_Name;
66 -- Used when the specified input and output are existing directories
68 Source_Ref_Pragma : Boolean := False;
69 -- Record command line options (set if -r switch set)
71 Text_Outfile : aliased Ada.Text_IO.File_Type;
72 Outfile : constant File_Access := Text_Outfile'Access;
74 File_Name_Buffer_Initial_Size : constant := 50;
75 File_Name_Buffer : String_Access :=
76 new String (1 .. File_Name_Buffer_Initial_Size);
77 -- A buffer to build output file names from input file names.
79 -----------------
80 -- Subprograms --
81 -----------------
83 procedure Display_Copyright;
84 -- Display the copyright notice
86 procedure Post_Scan;
87 -- Null procedure, needed by instantiation of Scng below
89 package Scanner is new Scng
90 (Post_Scan,
91 Errutil.Error_Msg,
92 Errutil.Error_Msg_S,
93 Errutil.Error_Msg_SC,
94 Errutil.Error_Msg_SP,
95 Errutil.Style);
96 -- The scanner for the preprocessor
98 function Is_ASCII_Letter (C : Character) return Boolean;
99 -- True if C is in 'a' .. 'z' or in 'A' .. 'Z'
101 procedure Double_File_Name_Buffer;
102 -- Double the size of the file name buffer.
104 procedure Preprocess_Infile_Name;
105 -- When the specified output is a directory, preprocess the infile name
106 -- for symbol substitution, to get the output file name.
108 procedure Process_Files;
109 -- Process the single input file or all the files in the directory tree
110 -- rooted at the input directory.
112 procedure Process_Command_Line_Symbol_Definition (S : String);
113 -- Process a -D switch on the command line
115 procedure Put_Char_To_Outfile (C : Character);
116 -- Output one character to the output file.
117 -- Used to initialize the preprocessor.
119 procedure New_EOL_To_Outfile;
120 -- Output a new line to the output file.
121 -- Used to initialize the preprocessor.
123 procedure Scan_Command_Line;
124 -- Scan the switches and the file names
126 procedure Usage;
127 -- Display the usage
129 -----------------------
130 -- Display_Copyright --
131 -----------------------
133 procedure Display_Copyright is
134 begin
135 if not Copyright_Displayed then
136 Write_Line ("GNAT Preprocessor " &
137 Gnatvsn.Gnat_Version_String &
138 " Copyright 1996-2004 Free Software Foundation, Inc.");
139 Copyright_Displayed := True;
140 end if;
141 end Display_Copyright;
143 -----------------------------
144 -- Double_File_Name_Buffer --
145 -----------------------------
147 procedure Double_File_Name_Buffer is
148 New_Buffer : constant String_Access :=
149 new String (1 .. 2 * File_Name_Buffer'Length);
150 begin
151 New_Buffer (File_Name_Buffer'Range) := File_Name_Buffer.all;
152 Free (File_Name_Buffer);
153 File_Name_Buffer := New_Buffer;
154 end Double_File_Name_Buffer;
156 --------------
157 -- Gnatprep --
158 --------------
160 procedure Gnatprep is
161 begin
162 -- Do some initializations (order is important here!)
164 Csets.Initialize;
165 Namet.Initialize;
166 Snames.Initialize;
167 Stringt.Initialize;
169 -- Initialize the preprocessor
171 Prep.Initialize
172 (Error_Msg => Errutil.Error_Msg'Access,
173 Scan => Scanner.Scan'Access,
174 Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access,
175 Put_Char => Put_Char_To_Outfile'Access,
176 New_EOL => New_EOL_To_Outfile'Access);
178 -- Set the scanner characteristics for the preprocessor
180 Scanner.Set_Special_Character ('#');
181 Scanner.Set_Special_Character ('$');
182 Scanner.Set_End_Of_Line_As_Token (True);
184 -- Initialize the mapping table of symbols to values
186 Prep.Symbol_Table.Init (Prep.Mapping);
188 -- Parse the switches and arguments
190 Scan_Command_Line;
192 if Opt.Verbose_Mode then
193 Display_Copyright;
194 end if;
196 -- Test we had all the arguments needed
198 if Infile_Name = No_Name then
199 -- No input file specified, just output the usage and exit
201 Usage;
202 return;
204 elsif Outfile_Name = No_Name then
205 -- No output file specified, just output the usage and exit
207 Usage;
208 return;
209 end if;
211 -- If a pragma Source_File_Name, we need to keep line numbers.
212 -- So, if the deleted lines are not put as comment, we must output them
213 -- as blank lines.
215 if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
216 Opt.Blank_Deleted_Lines := True;
217 end if;
219 -- If we have a definition file, parse it
221 if Deffile_Name /= No_Name then
222 declare
223 Deffile : Source_File_Index;
225 begin
226 Errutil.Initialize;
227 Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
229 -- Set Main_Source_File to the definition file for the benefit of
230 -- Errutil.Finalize.
232 Sinput.Main_Source_File := Deffile;
234 if Deffile = No_Source_File then
235 Fail ("unable to find definition file """,
236 Get_Name_String (Deffile_Name),
237 """");
238 end if;
240 Scanner.Initialize_Scanner (No_Unit, Deffile);
242 Prep.Parse_Def_File;
243 end;
244 end if;
246 -- If there are errors in the definition file, output these errors
247 -- and exit.
249 if Total_Errors_Detected > 0 then
250 Errutil.Finalize (Source_Type => "definition");
251 Fail ("errors in definition file """,
252 Get_Name_String (Deffile_Name), """");
253 end if;
255 -- If -s switch was specified, print a sorted list of symbol names and
256 -- values, if any.
258 if Opt.List_Preprocessing_Symbols then
259 Prep.List_Symbols (Foreword => "");
260 end if;
262 Output_Directory := No_Name;
263 Input_Directory := No_Name;
265 -- Check if the specified output is an existing directory
267 if Is_Directory (Get_Name_String (Outfile_Name)) then
268 Output_Directory := Outfile_Name;
270 -- As the output is an existing directory, check if the input too
271 -- is a directory.
273 if Is_Directory (Get_Name_String (Infile_Name)) then
274 Input_Directory := Infile_Name;
275 end if;
276 end if;
278 -- And process the single input or the files in the directory tree
279 -- rooted at the input directory.
281 Process_Files;
283 end Gnatprep;
285 ---------------------
286 -- Is_ASCII_Letter --
287 ---------------------
289 function Is_ASCII_Letter (C : Character) return Boolean is
290 begin
291 return C in 'A' .. 'Z' or else C in 'a' .. 'z';
292 end Is_ASCII_Letter;
294 ------------------------
295 -- New_EOL_To_Outfile --
296 ------------------------
298 procedure New_EOL_To_Outfile is
299 begin
300 New_Line (Outfile.all);
301 end New_EOL_To_Outfile;
303 ---------------
304 -- Post_Scan --
305 ---------------
307 procedure Post_Scan is
308 begin
309 null;
310 end Post_Scan;
312 ----------------------------
313 -- Preprocess_Infile_Name --
314 ----------------------------
316 procedure Preprocess_Infile_Name is
317 Len : Natural;
318 First : Positive := 1;
319 Last : Natural;
320 Symbol : Name_Id;
321 Data : Symbol_Data;
323 begin
324 -- Initialize the buffer with the name of the input file
326 Get_Name_String (Infile_Name);
327 Len := Name_Len;
329 while File_Name_Buffer'Length < Len loop
330 Double_File_Name_Buffer;
331 end loop;
333 File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len);
335 -- Look for possible symbols in the file name
337 while First < Len loop
339 -- A symbol starts with a dollar sign followed by a letter
341 if File_Name_Buffer (First) = '$' and then
342 Is_ASCII_Letter (File_Name_Buffer (First + 1))
343 then
344 Last := First + 1;
346 -- Find the last letter of the symbol
348 while Last < Len and then
349 Is_ASCII_Letter (File_Name_Buffer (Last + 1))
350 loop
351 Last := Last + 1;
352 end loop;
354 -- Get the symbol name id
356 Name_Len := Last - First;
357 Name_Buffer (1 .. Name_Len) :=
358 File_Name_Buffer (First + 1 .. Last);
359 To_Lower (Name_Buffer (1 .. Name_Len));
360 Symbol := Name_Find;
362 -- And look for this symbol name in the symbol table
364 for Index in 1 .. Symbol_Table.Last (Mapping) loop
365 Data := Mapping.Table (Index);
367 if Data.Symbol = Symbol then
369 -- We found the symbol. If its value is not a string,
370 -- replace the symbol in the file name with the value of
371 -- the symbol.
373 if not Data.Is_A_String then
374 String_To_Name_Buffer (Data.Value);
376 declare
377 Sym_Len : constant Positive := Last - First + 1;
378 Offset : constant Integer := Name_Len - Sym_Len;
379 New_Len : constant Natural := Len + Offset;
381 begin
382 while New_Len > File_Name_Buffer'Length loop
383 Double_File_Name_Buffer;
384 end loop;
386 File_Name_Buffer (Last + 1 + Offset .. New_Len) :=
387 File_Name_Buffer (Last + 1 .. Len);
388 Len := New_Len;
389 Last := Last + Offset;
390 File_Name_Buffer (First .. Last) :=
391 Name_Buffer (1 .. Name_Len);
392 end;
393 end if;
395 exit;
396 end if;
397 end loop;
399 -- Skip over the symbol name or its value: we are not checking
400 -- for another symbol name in the value.
402 First := Last + 1;
404 else
405 First := First + 1;
406 end if;
407 end loop;
409 -- We now have the output file name in the buffer. Get the output
410 -- path and put it in Outfile_Name.
412 Get_Name_String (Output_Directory);
413 Add_Char_To_Name_Buffer (Directory_Separator);
414 Add_Str_To_Name_Buffer (File_Name_Buffer (1 .. Len));
415 Outfile_Name := Name_Find;
416 end Preprocess_Infile_Name;
418 --------------------------------------------
419 -- Process_Command_Line_Symbol_Definition --
420 --------------------------------------------
422 procedure Process_Command_Line_Symbol_Definition (S : String) is
423 Data : Symbol_Data;
424 Symbol : Symbol_Id;
426 begin
427 -- Check the symbol definition and get the symbol and its value.
428 -- Fail if symbol definition is illegal.
430 Check_Command_Line_Symbol_Definition (S, Data);
432 Symbol := Index_Of (Data.Symbol);
434 -- If symbol does not alrady exist, create a new entry in the mapping
435 -- table.
437 if Symbol = No_Symbol then
438 Symbol_Table.Increment_Last (Mapping);
439 Symbol := Symbol_Table.Last (Mapping);
440 end if;
442 Mapping.Table (Symbol) := Data;
443 end Process_Command_Line_Symbol_Definition;
445 -------------------
446 -- Process_Files --
447 -------------------
449 procedure Process_Files is
451 procedure Process_One_File;
452 -- Process input file Infile_Name and put the result in file
453 -- Outfile_Name.
455 procedure Recursive_Process (In_Dir : String; Out_Dir : String);
456 -- Process recursively files in In_Dir. Results go to Out_Dir.
458 ----------------------
459 -- Process_One_File --
460 ----------------------
462 procedure Process_One_File is
463 Infile : Source_File_Index;
465 begin
466 -- Create the output file; fails if this does not work.
468 begin
469 Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name));
471 exception
472 when others =>
473 Fail
474 ("unable to create output file """,
475 Get_Name_String (Outfile_Name), """");
476 end;
478 -- Load the input file
480 Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name));
482 if Infile = No_Source_File then
483 Fail ("unable to find input file """,
484 Get_Name_String (Infile_Name), """");
485 end if;
487 -- Set Main_Source_File to the input file for the benefit of
488 -- Errutil.Finalize.
490 Sinput.Main_Source_File := Infile;
492 Scanner.Initialize_Scanner (No_Unit, Infile);
494 -- Output the SFN pragma if asked to
496 if Source_Ref_Pragma then
497 Put_Line (Outfile.all, "pragma Source_Reference (1, """ &
498 Get_Name_String (Sinput.File_Name (Infile)) &
499 """);");
500 end if;
502 -- Preprocess the input file
504 Prep.Preprocess;
506 -- In verbose mode, if there is no error, report it
508 if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then
509 Errutil.Finalize (Source_Type => "input");
510 end if;
512 -- If we had some errors, delete the output file, and report
513 -- the errors.
515 if Err_Vars.Total_Errors_Detected > 0 then
516 if Outfile /= Standard_Output then
517 Delete (Text_Outfile);
518 end if;
520 Errutil.Finalize (Source_Type => "input");
522 OS_Exit (0);
524 -- otherwise, close the output file, and we are done.
526 elsif Outfile /= Standard_Output then
527 Close (Text_Outfile);
528 end if;
529 end Process_One_File;
531 -----------------------
532 -- Recursive_Process --
533 -----------------------
535 procedure Recursive_Process (In_Dir : String; Out_Dir : String) is
536 Dir_In : Dir_Type;
537 Name : String (1 .. 255);
538 Last : Natural;
539 In_Dir_Name : Name_Id;
540 Out_Dir_Name : Name_Id;
542 procedure Set_Directory_Names;
543 -- Establish or reestablish the current input and output directories
545 -------------------------
546 -- Set_Directory_Names --
547 -------------------------
549 procedure Set_Directory_Names is
550 begin
551 Input_Directory := In_Dir_Name;
552 Output_Directory := Out_Dir_Name;
553 end Set_Directory_Names;
555 begin
556 -- Open the current input directory
558 begin
559 Open (Dir_In, In_Dir);
561 exception
562 when Directory_Error =>
563 Fail ("could not read directory " & In_Dir);
564 end;
566 -- Set the new input and output directory names
568 Name_Len := In_Dir'Length;
569 Name_Buffer (1 .. Name_Len) := In_Dir;
570 In_Dir_Name := Name_Find;
571 Name_Len := Out_Dir'Length;
572 Name_Buffer (1 .. Name_Len) := Out_Dir;
573 Out_Dir_Name := Name_Find;
575 Set_Directory_Names;
577 -- Traverse the input directory
578 loop
579 Read (Dir_In, Name, Last);
580 exit when Last = 0;
582 if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
583 declare
584 Input : constant String :=
585 In_Dir & Directory_Separator & Name (1 .. Last);
586 Output : constant String :=
587 Out_Dir & Directory_Separator & Name (1 .. Last);
589 begin
590 -- If input is an ordinary file, process it
592 if Is_Regular_File (Input) then
593 -- First get the output file name
595 Name_Len := Last;
596 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
597 Infile_Name := Name_Find;
598 Preprocess_Infile_Name;
600 -- Set the input file name and process the file
602 Name_Len := Input'Length;
603 Name_Buffer (1 .. Name_Len) := Input;
604 Infile_Name := Name_Find;
605 Process_One_File;
607 elsif Is_Directory (Input) then
608 -- Input is a directory. If the corresponding output
609 -- directory does not already exist, create it.
611 if not Is_Directory (Output) then
612 begin
613 Make_Dir (Dir_Name => Output);
615 exception
616 when Directory_Error =>
617 Fail ("could not create directory """,
618 Output, """");
619 end;
620 end if;
622 -- And process this new input directory
624 Recursive_Process (Input, Output);
626 -- Reestablish the input and output directory names
627 -- that have been modified by the recursive call.
629 Set_Directory_Names;
630 end if;
631 end;
632 end if;
633 end loop;
634 end Recursive_Process;
636 begin
637 if Output_Directory = No_Name then
638 -- If the output is not a directory, fail if the input is
639 -- an existing directory, to avoid possible problems.
641 if Is_Directory (Get_Name_String (Infile_Name)) then
642 Fail ("input file """ & Get_Name_String (Infile_Name) &
643 """ is a directory");
644 end if;
646 -- Just process the single input file
648 Process_One_File;
650 elsif Input_Directory = No_Name then
651 -- Get the output file name from the input file name, and process
652 -- the single input file.
654 Preprocess_Infile_Name;
655 Process_One_File;
657 else
658 -- Recursively process files in the directory tree rooted at the
659 -- input directory.
661 Recursive_Process
662 (In_Dir => Get_Name_String (Input_Directory),
663 Out_Dir => Get_Name_String (Output_Directory));
664 end if;
665 end Process_Files;
667 -------------------------
668 -- Put_Char_To_Outfile --
669 -------------------------
671 procedure Put_Char_To_Outfile (C : Character) is
672 begin
673 Put (Outfile.all, C);
674 end Put_Char_To_Outfile;
676 -----------------------
677 -- Scan_Command_Line --
678 -----------------------
680 procedure Scan_Command_Line is
681 Switch : Character;
683 begin
684 -- Parse the switches
686 loop
687 begin
688 Switch := GNAT.Command_Line.Getopt ("D: b c r s u v");
689 case Switch is
691 when ASCII.NUL =>
692 exit;
694 when 'D' =>
695 Process_Command_Line_Symbol_Definition
696 (S => GNAT.Command_Line.Parameter);
698 when 'b' =>
699 Opt.Blank_Deleted_Lines := True;
701 when 'c' =>
702 Opt.Comment_Deleted_Lines := True;
704 when 'r' =>
705 Source_Ref_Pragma := True;
707 when 's' =>
708 Opt.List_Preprocessing_Symbols := True;
710 when 'u' =>
711 Opt.Undefined_Symbols_Are_False := True;
713 when 'v' =>
714 Opt.Verbose_Mode := True;
716 when others =>
717 Fail ("Invalid Switch: -" & Switch);
718 end case;
720 exception
721 when GNAT.Command_Line.Invalid_Switch =>
722 Write_Str ("Invalid Switch: -");
723 Write_Line (GNAT.Command_Line.Full_Switch);
724 Usage;
725 OS_Exit (1);
726 end;
727 end loop;
729 -- Get the file names
731 loop
732 declare
733 S : constant String := GNAT.Command_Line.Get_Argument;
735 begin
736 exit when S'Length = 0;
738 Name_Len := S'Length;
739 Name_Buffer (1 .. Name_Len) := S;
741 if Infile_Name = No_Name then
742 Infile_Name := Name_Find;
743 elsif Outfile_Name = No_Name then
744 Outfile_Name := Name_Find;
745 elsif Deffile_Name = No_Name then
746 Deffile_Name := Name_Find;
747 else
748 Fail ("too many arguments specifed");
749 end if;
750 end;
751 end loop;
752 end Scan_Command_Line;
754 -----------
755 -- Usage --
756 -----------
758 procedure Usage is
759 begin
760 Display_Copyright;
761 Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
762 "infile outfile [deffile]");
763 Write_Eol;
764 Write_Line (" infile Name of the input file");
765 Write_Line (" outfile Name of the output file");
766 Write_Line (" deffile Name of the definition file");
767 Write_Eol;
768 Write_Line ("gnatprep switches:");
769 Write_Line (" -b Replace preprocessor lines by blank lines");
770 Write_Line (" -c Keep preprocessor lines as comments");
771 Write_Line (" -D Associate symbol with value");
772 Write_Line (" -r Generate Source_Reference pragma");
773 Write_Line (" -s Print a sorted list of symbol names and values");
774 Write_Line (" -u Treat undefined symbols as FALSE");
775 Write_Line (" -v Verbose mode");
776 Write_Eol;
777 end Usage;
779 end GPrep;