OSDN Git Service

2005-06-15 Andrew Pinski <pinskia@physics.uc.edu>
[pf3gnuchains/gcc-fork.git] / gcc / ada / gprep.adb
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 ------------------------------------------------------------------------------
26
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;
41
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;
47
48 package body GPrep is
49
50    Copyright_Displayed : Boolean := False;
51    --  Used to prevent multiple displays of the copyright notice
52
53    ------------------------
54    -- Argument Line Data --
55    ------------------------
56
57    Infile_Name  : Name_Id := No_Name;
58    Outfile_Name : Name_Id := No_Name;
59    Deffile_Name : Name_Id := No_Name;
60
61    Output_Directory : Name_Id := No_Name;
62    --  Used when the specified output is an existing directory
63
64    Input_Directory : Name_Id := No_Name;
65    --  Used when the specified input and output are existing directories
66
67    Source_Ref_Pragma : Boolean := False;
68    --  Record command line options (set if -r switch set)
69
70    Text_Outfile : aliased Ada.Text_IO.File_Type;
71    Outfile      : constant File_Access := Text_Outfile'Access;
72
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.
77
78    -----------------
79    -- Subprograms --
80    -----------------
81
82    procedure Display_Copyright;
83    --  Display the copyright notice
84
85    procedure Obsolescent_Check (S : Source_Ptr);
86    --  Null procedure, needed by instantiation of Scng below
87
88    procedure Post_Scan;
89    --  Null procedure, needed by instantiation of Scng below
90
91    package Scanner is new Scng
92      (Post_Scan,
93       Errutil.Error_Msg,
94       Errutil.Error_Msg_S,
95       Errutil.Error_Msg_SC,
96       Errutil.Error_Msg_SP,
97       Obsolescent_Check,
98       Errutil.Style);
99    --  The scanner for the preprocessor
100
101    function Is_ASCII_Letter (C : Character) return Boolean;
102    --  True if C is in 'a' .. 'z' or in 'A' .. 'Z'
103
104    procedure Double_File_Name_Buffer;
105    --  Double the size of the file name buffer.
106
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.
110
111    procedure Process_Files;
112    --  Process the single input file or all the files in the directory tree
113    --  rooted at the input directory.
114
115    procedure Process_Command_Line_Symbol_Definition (S : String);
116    --  Process a -D switch on the command line
117
118    procedure Put_Char_To_Outfile (C : Character);
119    --  Output one character to the output file.
120    --  Used to initialize the preprocessor.
121
122    procedure New_EOL_To_Outfile;
123    --  Output a new line to the output file.
124    --  Used to initialize the preprocessor.
125
126    procedure Scan_Command_Line;
127    --  Scan the switches and the file names
128
129    procedure Usage;
130    --  Display the usage
131
132    -----------------------
133    -- Display_Copyright --
134    -----------------------
135
136    procedure Display_Copyright is
137    begin
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;
142       end if;
143    end Display_Copyright;
144
145    -----------------------------
146    -- Double_File_Name_Buffer --
147    -----------------------------
148
149    procedure Double_File_Name_Buffer is
150       New_Buffer : constant String_Access :=
151                      new String (1 .. 2 * File_Name_Buffer'Length);
152    begin
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;
157
158    --------------
159    -- Gnatprep --
160    --------------
161
162    procedure Gnatprep is
163    begin
164       --  Do some initializations (order is important here!)
165
166       Csets.Initialize;
167       Namet.Initialize;
168       Snames.Initialize;
169       Stringt.Initialize;
170
171       --  Initialize the preprocessor
172
173       Prep.Initialize
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);
179
180       --  Set the scanner characteristics for the preprocessor
181
182       Scanner.Set_Special_Character ('#');
183       Scanner.Set_Special_Character ('$');
184       Scanner.Set_End_Of_Line_As_Token (True);
185
186       --  Initialize the mapping table of symbols to values
187
188       Prep.Symbol_Table.Init (Prep.Mapping);
189
190       --  Parse the switches and arguments
191
192       Scan_Command_Line;
193
194       if Opt.Verbose_Mode then
195          Display_Copyright;
196       end if;
197
198       --  Test we had all the arguments needed
199
200       if Infile_Name = No_Name then
201          --  No input file specified, just output the usage and exit
202
203          Usage;
204          return;
205
206       elsif Outfile_Name = No_Name then
207          --  No output file specified, just output the usage and exit
208
209          Usage;
210          return;
211       end if;
212
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
215       --  as blank lines.
216
217       if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
218          Opt.Blank_Deleted_Lines := True;
219       end if;
220
221       --  If we have a definition file, parse it
222
223       if Deffile_Name /= No_Name then
224          declare
225             Deffile : Source_File_Index;
226
227          begin
228             Errutil.Initialize;
229             Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
230
231             --  Set Main_Source_File to the definition file for the benefit of
232             --  Errutil.Finalize.
233
234             Sinput.Main_Source_File := Deffile;
235
236             if Deffile = No_Source_File then
237                Fail ("unable to find definition file """,
238                      Get_Name_String (Deffile_Name),
239                      """");
240             end if;
241
242             Scanner.Initialize_Scanner (No_Unit, Deffile);
243
244             Prep.Parse_Def_File;
245          end;
246       end if;
247
248       --  If there are errors in the definition file, output these errors
249       --  and exit.
250
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), """");
255       end if;
256
257       --  If -s switch was specified, print a sorted list of symbol names and
258       --  values, if any.
259
260       if Opt.List_Preprocessing_Symbols then
261          Prep.List_Symbols (Foreword => "");
262       end if;
263
264       Output_Directory := No_Name;
265       Input_Directory  := No_Name;
266
267       --  Check if the specified output is an existing directory
268
269       if Is_Directory (Get_Name_String (Outfile_Name)) then
270          Output_Directory := Outfile_Name;
271
272          --  As the output is an existing directory, check if the input too
273          --  is a directory.
274
275          if Is_Directory (Get_Name_String (Infile_Name)) then
276             Input_Directory := Infile_Name;
277          end if;
278       end if;
279
280       --  And process the single input or the files in the directory tree
281       --  rooted at the input directory.
282
283       Process_Files;
284
285    end Gnatprep;
286
287    ---------------------
288    -- Is_ASCII_Letter --
289    ---------------------
290
291    function Is_ASCII_Letter (C : Character) return Boolean is
292    begin
293       return C in 'A' .. 'Z' or else C in 'a' .. 'z';
294    end Is_ASCII_Letter;
295
296    ------------------------
297    -- New_EOL_To_Outfile --
298    ------------------------
299
300    procedure New_EOL_To_Outfile is
301    begin
302       New_Line (Outfile.all);
303    end New_EOL_To_Outfile;
304
305    -----------------------
306    -- Obsolescent_Check --
307    -----------------------
308
309    procedure Obsolescent_Check (S : Source_Ptr) is
310       pragma Warnings (Off, S);
311    begin
312       null;
313    end Obsolescent_Check;
314
315
316    ---------------
317    -- Post_Scan --
318    ---------------
319
320    procedure Post_Scan is
321    begin
322       null;
323    end Post_Scan;
324
325    ----------------------------
326    -- Preprocess_Infile_Name --
327    ----------------------------
328
329    procedure Preprocess_Infile_Name is
330       Len    : Natural;
331       First  : Positive := 1;
332       Last   : Natural;
333       Symbol : Name_Id;
334       Data   : Symbol_Data;
335
336    begin
337       --  Initialize the buffer with the name of the input file
338
339       Get_Name_String (Infile_Name);
340       Len := Name_Len;
341
342       while File_Name_Buffer'Length < Len loop
343          Double_File_Name_Buffer;
344       end loop;
345
346       File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len);
347
348       --  Look for possible symbols in the file name
349
350       while First < Len loop
351
352          --  A symbol starts with a dollar sign followed by a letter
353
354          if File_Name_Buffer (First) = '$' and then
355            Is_ASCII_Letter (File_Name_Buffer (First + 1))
356          then
357             Last := First + 1;
358
359             --  Find the last letter of the symbol
360
361             while Last < Len and then
362                Is_ASCII_Letter (File_Name_Buffer (Last + 1))
363             loop
364                Last := Last + 1;
365             end loop;
366
367             --  Get the symbol name id
368
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));
373             Symbol := Name_Find;
374
375             --  And look for this symbol name in the symbol table
376
377             for Index in 1 .. Symbol_Table.Last (Mapping) loop
378                Data := Mapping.Table (Index);
379
380                if Data.Symbol = Symbol then
381
382                   --  We found the symbol. If its value is not a string,
383                   --  replace the symbol in the file name with the value of
384                   --  the symbol.
385
386                   if not Data.Is_A_String then
387                      String_To_Name_Buffer (Data.Value);
388
389                      declare
390                         Sym_Len : constant Positive := Last - First + 1;
391                         Offset : constant Integer := Name_Len - Sym_Len;
392                         New_Len : constant Natural := Len + Offset;
393
394                      begin
395                         while New_Len > File_Name_Buffer'Length loop
396                            Double_File_Name_Buffer;
397                         end loop;
398
399                         File_Name_Buffer (Last + 1 + Offset .. New_Len) :=
400                           File_Name_Buffer (Last + 1 .. Len);
401                         Len := New_Len;
402                         Last := Last + Offset;
403                         File_Name_Buffer (First .. Last) :=
404                           Name_Buffer (1 .. Name_Len);
405                      end;
406                   end if;
407
408                   exit;
409                end if;
410             end loop;
411
412             --  Skip over the symbol name or its value: we are not checking
413             --  for another symbol name in the value.
414
415             First := Last + 1;
416
417          else
418             First := First + 1;
419          end if;
420       end loop;
421
422       --  We now have the output file name in the buffer. Get the output
423       --  path and put it in Outfile_Name.
424
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;
430
431    --------------------------------------------
432    -- Process_Command_Line_Symbol_Definition --
433    --------------------------------------------
434
435    procedure Process_Command_Line_Symbol_Definition (S : String) is
436       Data   : Symbol_Data;
437       Symbol : Symbol_Id;
438
439    begin
440       --  Check the symbol definition and get the symbol and its value.
441       --  Fail if symbol definition is illegal.
442
443       Check_Command_Line_Symbol_Definition (S, Data);
444
445       Symbol := Index_Of (Data.Symbol);
446
447       --  If symbol does not alrady exist, create a new entry in the mapping
448       --  table.
449
450       if Symbol = No_Symbol then
451          Symbol_Table.Increment_Last (Mapping);
452          Symbol := Symbol_Table.Last (Mapping);
453       end if;
454
455       Mapping.Table (Symbol) := Data;
456    end Process_Command_Line_Symbol_Definition;
457
458    -------------------
459    -- Process_Files --
460    -------------------
461
462    procedure Process_Files is
463
464       procedure Process_One_File;
465       --  Process input file Infile_Name and put the result in file
466       --  Outfile_Name.
467
468       procedure Recursive_Process (In_Dir : String; Out_Dir : String);
469       --  Process recursively files in In_Dir. Results go to Out_Dir.
470
471       ----------------------
472       -- Process_One_File --
473       ----------------------
474
475       procedure Process_One_File is
476          Infile : Source_File_Index;
477
478       begin
479          --  Create the output file; fails if this does not work.
480
481          begin
482             Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name));
483
484          exception
485             when others =>
486                Fail
487                  ("unable to create output file """,
488                   Get_Name_String (Outfile_Name), """");
489          end;
490
491          --  Load the input file
492
493          Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name));
494
495          if Infile = No_Source_File then
496             Fail ("unable to find input file """,
497                   Get_Name_String (Infile_Name), """");
498          end if;
499
500          --  Set Main_Source_File to the input file for the benefit of
501          --  Errutil.Finalize.
502
503          Sinput.Main_Source_File := Infile;
504
505          Scanner.Initialize_Scanner (No_Unit, Infile);
506
507          --  Output the SFN pragma if asked to
508
509          if Source_Ref_Pragma then
510             Put_Line (Outfile.all, "pragma Source_Reference (1, """ &
511                       Get_Name_String (Sinput.File_Name (Infile)) &
512                       """);");
513          end if;
514
515          --  Preprocess the input file
516
517          Prep.Preprocess;
518
519          --  In verbose mode, if there is no error, report it
520
521          if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then
522             Errutil.Finalize (Source_Type => "input");
523          end if;
524
525          --  If we had some errors, delete the output file, and report
526          --  the errors.
527
528          if Err_Vars.Total_Errors_Detected > 0 then
529             if Outfile /= Standard_Output then
530                Delete (Text_Outfile);
531             end if;
532
533             Errutil.Finalize (Source_Type => "input");
534
535             OS_Exit (0);
536
537          --  otherwise, close the output file, and we are done.
538
539          elsif Outfile /= Standard_Output then
540             Close (Text_Outfile);
541          end if;
542       end Process_One_File;
543
544       -----------------------
545       -- Recursive_Process --
546       -----------------------
547
548       procedure Recursive_Process (In_Dir : String; Out_Dir : String) is
549          Dir_In : Dir_Type;
550          Name : String (1 .. 255);
551          Last : Natural;
552          In_Dir_Name  : Name_Id;
553          Out_Dir_Name : Name_Id;
554
555          procedure Set_Directory_Names;
556          --  Establish or reestablish the current input and output directories
557
558          -------------------------
559          -- Set_Directory_Names --
560          -------------------------
561
562          procedure Set_Directory_Names is
563          begin
564             Input_Directory := In_Dir_Name;
565             Output_Directory := Out_Dir_Name;
566          end Set_Directory_Names;
567
568       begin
569          --  Open the current input directory
570
571          begin
572             Open (Dir_In, In_Dir);
573
574          exception
575             when Directory_Error =>
576                Fail ("could not read directory " & In_Dir);
577          end;
578
579          --  Set the new input and output directory names
580
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;
587
588          Set_Directory_Names;
589
590          --  Traverse the input directory
591          loop
592             Read (Dir_In, Name, Last);
593             exit when Last = 0;
594
595             if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
596                declare
597                   Input : constant String :=
598                             In_Dir & Directory_Separator & Name (1 .. Last);
599                   Output : constant String :=
600                              Out_Dir & Directory_Separator & Name (1 .. Last);
601
602                begin
603                   --  If input is an ordinary file, process it
604
605                   if Is_Regular_File (Input) then
606                      --  First get the output file name
607
608                      Name_Len := Last;
609                      Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
610                      Infile_Name := Name_Find;
611                      Preprocess_Infile_Name;
612
613                      --  Set the input file name and process the file
614
615                      Name_Len := Input'Length;
616                      Name_Buffer (1 .. Name_Len) := Input;
617                      Infile_Name := Name_Find;
618                      Process_One_File;
619
620                   elsif Is_Directory (Input) then
621                      --  Input is a directory. If the corresponding output
622                      --  directory does not already exist, create it.
623
624                      if not Is_Directory (Output) then
625                         begin
626                            Make_Dir (Dir_Name => Output);
627
628                         exception
629                            when Directory_Error =>
630                               Fail ("could not create directory """,
631                                     Output, """");
632                         end;
633                      end if;
634
635                      --  And process this new input directory
636
637                      Recursive_Process (Input, Output);
638
639                      --  Reestablish the input and output directory names
640                      --  that have been modified by the recursive call.
641
642                      Set_Directory_Names;
643                   end if;
644                end;
645             end if;
646          end loop;
647       end Recursive_Process;
648
649    begin
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.
653
654          if Is_Directory (Get_Name_String (Infile_Name)) then
655             Fail ("input file """ & Get_Name_String (Infile_Name) &
656                   """ is a directory");
657          end if;
658
659          --  Just process the single input file
660
661          Process_One_File;
662
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.
666
667          Preprocess_Infile_Name;
668          Process_One_File;
669
670       else
671          --  Recursively process files in the directory tree rooted at the
672          --  input directory.
673
674          Recursive_Process
675            (In_Dir => Get_Name_String (Input_Directory),
676             Out_Dir => Get_Name_String (Output_Directory));
677       end if;
678    end Process_Files;
679
680    -------------------------
681    -- Put_Char_To_Outfile --
682    -------------------------
683
684    procedure Put_Char_To_Outfile (C : Character) is
685    begin
686       Put (Outfile.all, C);
687    end Put_Char_To_Outfile;
688
689    -----------------------
690    -- Scan_Command_Line --
691    -----------------------
692
693    procedure Scan_Command_Line is
694       Switch : Character;
695
696    begin
697       --  Parse the switches
698
699       loop
700          begin
701             Switch := GNAT.Command_Line.Getopt ("D: b c r s u v");
702             case Switch is
703
704                when ASCII.NUL =>
705                   exit;
706
707                when 'D' =>
708                   Process_Command_Line_Symbol_Definition
709                     (S => GNAT.Command_Line.Parameter);
710
711                when 'b' =>
712                   Opt.Blank_Deleted_Lines := True;
713
714                when 'c' =>
715                   Opt.Comment_Deleted_Lines := True;
716
717                when 'r' =>
718                   Source_Ref_Pragma := True;
719
720                when 's' =>
721                   Opt.List_Preprocessing_Symbols := True;
722
723                when 'u' =>
724                   Opt.Undefined_Symbols_Are_False := True;
725
726                when 'v' =>
727                   Opt.Verbose_Mode := True;
728
729                when others =>
730                   Fail ("Invalid Switch: -" & Switch);
731             end case;
732
733          exception
734             when GNAT.Command_Line.Invalid_Switch =>
735                Write_Str ("Invalid Switch: -");
736                Write_Line (GNAT.Command_Line.Full_Switch);
737                Usage;
738                OS_Exit (1);
739          end;
740       end loop;
741
742       --  Get the file names
743
744       loop
745          declare
746             S : constant String := GNAT.Command_Line.Get_Argument;
747
748          begin
749             exit when S'Length = 0;
750
751             Name_Len := S'Length;
752             Name_Buffer (1 .. Name_Len) := S;
753
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;
760             else
761                Fail ("too many arguments specifed");
762             end if;
763          end;
764       end loop;
765    end Scan_Command_Line;
766
767    -----------
768    -- Usage --
769    -----------
770
771    procedure Usage is
772    begin
773       Display_Copyright;
774       Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
775                     "infile outfile [deffile]");
776       Write_Eol;
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");
780       Write_Eol;
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");
789       Write_Eol;
790    end Usage;
791
792 end GPrep;