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
27with Csets;
28with Err_Vars; use Err_Vars;
29with Errutil;
30with Gnatvsn;
31with Namet;    use Namet;
32with Opt;
33with Osint;    use Osint;
34with Output;   use Output;
35with Prep;     use Prep;
36with Scng;
37with Sinput.C;
38with Snames;
39with Stringt;  use Stringt;
40with Types;    use Types;
41
42with Ada.Text_IO;       use Ada.Text_IO;
43with GNAT.Command_Line;
44with GNAT.OS_Lib;       use GNAT.OS_Lib;
45
46package body GPrep is
47
48   Copyright_Displayed : Boolean := False;
49   --  Used to prevent multiple displays of the copyright notice
50
51   ------------------------
52   -- Argument Line Data --
53   ------------------------
54
55   Infile_Name  : String_Access;
56   Outfile_Name : String_Access;
57   Deffile_Name : String_Access;
58
59   Source_Ref_Pragma : Boolean := False;
60   --  Record command line options (set if -r switch set)
61
62   Text_Outfile : aliased Ada.Text_IO.File_Type;
63   Outfile      : constant File_Access := Text_Outfile'Access;
64
65   -----------------
66   -- Subprograms --
67   -----------------
68
69   procedure Display_Copyright;
70   --  Display the copyright notice
71
72   procedure Post_Scan;
73   --  Null procedure, needed by instantiation of Scng below
74
75   package Scanner is new Scng
76     (Post_Scan,
77      Errutil.Error_Msg,
78      Errutil.Error_Msg_S,
79      Errutil.Error_Msg_SC,
80      Errutil.Error_Msg_SP,
81      Errutil.Style);
82   --  The scanner for the preprocessor
83
84   procedure Process_Command_Line_Symbol_Definition (S : String);
85   --  Process a -D switch on ther command line
86
87   procedure Put_Char_To_Outfile (C : Character);
88   --  Output one character to the output file.
89   --  Used to initialize the preprocessor.
90
91   procedure New_EOL_To_Outfile;
92   --  Output a new line to the output file.
93   --  Used to initialize the preprocessor.
94
95   procedure Scan_Command_Line;
96   --  Scan the switches and the file names
97
98   procedure Usage;
99   --  Display the usage
100
101   -----------------------
102   -- Display_Copyright --
103   -----------------------
104
105   procedure Display_Copyright is
106   begin
107      if not Copyright_Displayed then
108         Write_Line ("GNAT Preprocessor " &
109                     Gnatvsn.Gnat_Version_String &
110                     " Copyright 1996-2004 Free Software Foundation, Inc.");
111         Copyright_Displayed := True;
112      end if;
113   end Display_Copyright;
114
115   --------------
116   -- Gnatprep --
117   --------------
118
119   procedure Gnatprep is
120      Infile : Source_File_Index;
121
122   begin
123      --  Do some initializations (order is important here!)
124
125      Csets.Initialize;
126      Namet.Initialize;
127      Snames.Initialize;
128      Stringt.Initialize;
129
130      --  Initialize the preprocessor
131
132      Prep.Initialize
133        (Error_Msg         => Errutil.Error_Msg'Access,
134         Scan              => Scanner.Scan'Access,
135         Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access,
136         Put_Char          => Put_Char_To_Outfile'Access,
137         New_EOL           => New_EOL_To_Outfile'Access);
138
139      --  Set the scanner characteristics for the preprocessor
140
141      Scanner.Set_Special_Character ('#');
142      Scanner.Set_Special_Character ('$');
143      Scanner.Set_End_Of_Line_As_Token (True);
144
145      --  Initialize the mapping table of symbols to values
146
147      Prep.Symbol_Table.Init (Prep.Mapping);
148
149      --  Parse the switches and arguments
150
151      Scan_Command_Line;
152
153      if Opt.Verbose_Mode then
154         Display_Copyright;
155      end if;
156
157      --  Test we had all the arguments needed
158
159      if Infile_Name = null then
160         --  No input file specified, just output the usage and exit
161
162         Usage;
163         return;
164      elsif Outfile_Name = null then
165         --  No output file specified, just output the usage and exit
166
167         Usage;
168         return;
169      end if;
170
171      --  If a pragma Source_File_Name, we need to keep line numbers.
172      --  So, if the deleted lines are not put as comment, we must output them
173      --  as blank lines.
174
175      if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
176         Opt.Blank_Deleted_Lines := True;
177      end if;
178
179      --  If we have a definition file, parse it
180
181      if Deffile_Name /= null then
182         declare
183            Deffile : Source_File_Index;
184
185         begin
186            Errutil.Initialize;
187            Deffile := Sinput.C.Load_File (Deffile_Name.all);
188
189            --  Set Main_Source_File to the definition file for the benefit of
190            --  Errutil.Finalize.
191
192            Sinput.Main_Source_File := Deffile;
193
194            if Deffile = No_Source_File then
195               Fail ("unable to find definition file """,
196                     Deffile_Name.all,
197                     """");
198            end if;
199
200            Scanner.Initialize_Scanner (No_Unit, Deffile);
201
202            Prep.Parse_Def_File;
203         end;
204      end if;
205
206      --  If there are errors in the definition file, output these errors
207      --  and exit.
208
209      if Total_Errors_Detected > 0 then
210         Errutil.Finalize (Source_Type => "definition");
211         Fail ("errors in definition file """, Deffile_Name.all, """");
212      end if;
213
214      --  If -s switch was specified, print a sorted list of symbol names and
215      --  values, if any.
216
217      if Opt.List_Preprocessing_Symbols then
218         Prep.List_Symbols (Foreword => "");
219      end if;
220
221      --  Load the input file
222
223      Infile := Sinput.C.Load_File (Infile_Name.all);
224
225      if Infile = No_Source_File then
226         Fail ("unable to find input file """, Infile_Name.all, """");
227      end if;
228
229      --  Set Main_Source_File to the input file for the benefit of
230      --  Errutil.Finalize.
231
232      Sinput.Main_Source_File := Infile;
233
234      Scanner.Initialize_Scanner (No_Unit, Infile);
235
236      --  If an output file were specified, create it; fails if this did not
237      --  work.
238
239      if Outfile_Name /= null then
240         begin
241            Create (Text_Outfile, Out_File, Outfile_Name.all);
242
243         exception
244            when others =>
245               Fail
246                 ("unable to create output file """, Outfile_Name.all, """");
247         end;
248      end if;
249
250      --  Output the SFN pragma if asked to
251
252      if Source_Ref_Pragma then
253         Put_Line (Outfile.all, "pragma Source_Reference (1, """ &
254                   Get_Name_String (Sinput.File_Name (Infile)) &
255                   """);");
256      end if;
257
258      --  Preprocess the input file
259
260      Prep.Preprocess;
261
262      --  In verbose mode, if there is no error, report it
263
264      if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then
265         Errutil.Finalize (Source_Type => "input");
266      end if;
267
268      --  If we had some errors, delete the output file, and report the errors,
269
270      if Err_Vars.Total_Errors_Detected > 0 then
271         if Outfile /= Standard_Output then
272            Delete (Text_Outfile);
273         end if;
274
275         Errutil.Finalize (Source_Type => "input");
276
277      --  otherwise, close the output file, and we are done.
278
279      elsif Outfile /= Standard_Output then
280         Close (Text_Outfile);
281      end if;
282   end Gnatprep;
283
284   ------------------------
285   -- New_EOL_To_Outfile --
286   ------------------------
287
288   procedure New_EOL_To_Outfile is
289   begin
290      New_Line (Outfile.all);
291   end New_EOL_To_Outfile;
292
293   ---------------
294   -- Post_Scan --
295   ---------------
296
297   procedure Post_Scan is
298   begin
299      null;
300   end Post_Scan;
301
302   --------------------------------------------
303   -- Process_Command_Line_Symbol_Definition --
304   --------------------------------------------
305
306   procedure Process_Command_Line_Symbol_Definition (S : String) is
307      Data   : Symbol_Data;
308      Symbol : Symbol_Id;
309
310   begin
311      --  Check the symbol definition and get the symbol and its value.
312      --  Fail if symbol definition is illegal.
313
314      Check_Command_Line_Symbol_Definition (S, Data);
315
316      Symbol := Index_Of (Data.Symbol);
317
318      --  If symbol does not alrady exist, create a new entry in the mapping
319      --  table.
320
321      if Symbol = No_Symbol then
322         Symbol_Table.Increment_Last (Mapping);
323         Symbol := Symbol_Table.Last (Mapping);
324      end if;
325
326      Mapping.Table (Symbol) := Data;
327   end Process_Command_Line_Symbol_Definition;
328
329   -------------------------
330   -- Put_Char_To_Outfile --
331   -------------------------
332
333   procedure Put_Char_To_Outfile (C : Character) is
334   begin
335      Put (Outfile.all, C);
336   end Put_Char_To_Outfile;
337
338   -----------------------
339   -- Scan_Command_Line --
340   -----------------------
341
342   procedure Scan_Command_Line is
343      Switch : Character;
344
345   begin
346      --  Parse the switches
347
348      loop
349         begin
350            Switch := GNAT.Command_Line.Getopt ("D: b c r s u v");
351            case Switch is
352
353               when ASCII.NUL =>
354                  exit;
355
356               when 'D' =>
357                  Process_Command_Line_Symbol_Definition
358                    (S => GNAT.Command_Line.Parameter);
359
360               when 'b' =>
361                  Opt.Blank_Deleted_Lines := True;
362
363               when 'c' =>
364                  Opt.Comment_Deleted_Lines := True;
365
366               when 'r' =>
367                  Source_Ref_Pragma := True;
368
369               when 's' =>
370                  Opt.List_Preprocessing_Symbols := True;
371
372               when 'u' =>
373                  Opt.Undefined_Symbols_Are_False := True;
374
375               when 'v' =>
376                  Opt.Verbose_Mode := True;
377
378               when others =>
379                  Fail ("Invalid Switch: -" & Switch);
380            end case;
381
382         exception
383            when GNAT.Command_Line.Invalid_Switch =>
384               Write_Str ("Invalid Switch: -");
385               Write_Line (GNAT.Command_Line.Full_Switch);
386               Usage;
387               OS_Exit (1);
388         end;
389      end loop;
390
391      --  Get the file names
392
393      loop
394         declare
395            S : constant String := GNAT.Command_Line.Get_Argument;
396
397         begin
398            exit when S'Length = 0;
399
400            if Infile_Name = null then
401               Infile_Name := new String'(S);
402            elsif Outfile_Name = null then
403               Outfile_Name := new String'(S);
404            elsif Deffile_Name = null then
405               Deffile_Name := new String'(S);
406            else
407               Fail ("too many arguments specifed");
408            end if;
409         end;
410      end loop;
411   end Scan_Command_Line;
412
413   -----------
414   -- Usage --
415   -----------
416
417   procedure Usage is
418   begin
419      Display_Copyright;
420      Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
421                    "infile outfile [deffile]");
422      Write_Eol;
423      Write_Line ("  infile     Name of the input file");
424      Write_Line ("  outfile    Name of the output file");
425      Write_Line ("  deffile    Name of the definition file");
426      Write_Eol;
427      Write_Line ("gnatprep switches:");
428      Write_Line ("   -b  Replace preprocessor lines by blank lines");
429      Write_Line ("   -c  Keep preprocessor lines as comments");
430      Write_Line ("   -D  Associate symbol with value");
431      Write_Line ("   -r  Generate Source_Reference pragma");
432      Write_Line ("   -s  Print a sorted list of symbol names and values");
433      Write_Line ("   -u  Treat undefined symbols as FALSE");
434      Write_Line ("   -v  Verbose mode");
435      Write_Eol;
436   end Usage;
437
438end GPrep;
439