with Csets;
with Err_Vars; use Err_Vars;
with Errutil;
with Gnatvsn;
with Namet; use Namet;
with Opt;
with Osint; use Osint;
with Output; use Output;
with Prep; use Prep;
with Scng;
with Sinput.C;
with Snames;
with Stringt; use Stringt;
with Types; use Types;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
package body GPrep is
Copyright_Displayed : Boolean := False;
Infile_Name : Name_Id := No_Name;
Outfile_Name : Name_Id := No_Name;
Deffile_Name : Name_Id := No_Name;
Output_Directory : Name_Id := No_Name;
Input_Directory : Name_Id := No_Name;
Source_Ref_Pragma : Boolean := False;
Text_Outfile : aliased Ada.Text_IO.File_Type;
Outfile : constant File_Access := Text_Outfile'Access;
File_Name_Buffer_Initial_Size : constant := 50;
File_Name_Buffer : String_Access :=
new String (1 .. File_Name_Buffer_Initial_Size);
procedure Display_Copyright;
procedure Obsolescent_Check (S : Source_Ptr);
procedure Post_Scan;
package Scanner is new Scng
(Post_Scan,
Errutil.Error_Msg,
Errutil.Error_Msg_S,
Errutil.Error_Msg_SC,
Errutil.Error_Msg_SP,
Obsolescent_Check,
Errutil.Style);
function Is_ASCII_Letter (C : Character) return Boolean;
procedure Double_File_Name_Buffer;
procedure Preprocess_Infile_Name;
procedure Process_Files;
procedure Process_Command_Line_Symbol_Definition (S : String);
procedure Put_Char_To_Outfile (C : Character);
procedure New_EOL_To_Outfile;
procedure Scan_Command_Line;
procedure Usage;
procedure Display_Copyright is
begin
if not Copyright_Displayed then
Write_Line ("GNAT Preprocessor " & Gnatvsn.Gnat_Version_String);
Write_Line ("Copyright 1996-2004 Free Software Foundation, Inc.");
Copyright_Displayed := True;
end if;
end Display_Copyright;
procedure Double_File_Name_Buffer is
New_Buffer : constant String_Access :=
new String (1 .. 2 * File_Name_Buffer'Length);
begin
New_Buffer (File_Name_Buffer'Range) := File_Name_Buffer.all;
Free (File_Name_Buffer);
File_Name_Buffer := New_Buffer;
end Double_File_Name_Buffer;
procedure Gnatprep is
begin
Csets.Initialize;
Namet.Initialize;
Snames.Initialize;
Stringt.Initialize;
Prep.Initialize
(Error_Msg => Errutil.Error_Msg'Access,
Scan => Scanner.Scan'Access,
Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access,
Put_Char => Put_Char_To_Outfile'Access,
New_EOL => New_EOL_To_Outfile'Access);
Scanner.Set_Special_Character ('#');
Scanner.Set_Special_Character ('$');
Scanner.Set_End_Of_Line_As_Token (True);
Prep.Symbol_Table.Init (Prep.Mapping);
Scan_Command_Line;
if Opt.Verbose_Mode then
Display_Copyright;
end if;
if Infile_Name = No_Name then
Usage;
return;
elsif Outfile_Name = No_Name then
Usage;
return;
end if;
if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
Opt.Blank_Deleted_Lines := True;
end if;
if Deffile_Name /= No_Name then
declare
Deffile : Source_File_Index;
begin
Errutil.Initialize;
Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
Sinput.Main_Source_File := Deffile;
if Deffile = No_Source_File then
Fail ("unable to find definition file """,
Get_Name_String (Deffile_Name),
"""");
end if;
Scanner.Initialize_Scanner (No_Unit, Deffile);
Prep.Parse_Def_File;
end;
end if;
if Total_Errors_Detected > 0 then
Errutil.Finalize (Source_Type => "definition");
Fail ("errors in definition file """,
Get_Name_String (Deffile_Name), """");
end if;
if Opt.List_Preprocessing_Symbols then
Prep.List_Symbols (Foreword => "");
end if;
Output_Directory := No_Name;
Input_Directory := No_Name;
if Is_Directory (Get_Name_String (Outfile_Name)) then
Output_Directory := Outfile_Name;
if Is_Directory (Get_Name_String (Infile_Name)) then
Input_Directory := Infile_Name;
end if;
end if;
Process_Files;
end Gnatprep;
function Is_ASCII_Letter (C : Character) return Boolean is
begin
return C in 'A' .. 'Z' or else C in 'a' .. 'z';
end Is_ASCII_Letter;
procedure New_EOL_To_Outfile is
begin
New_Line (Outfile.all);
end New_EOL_To_Outfile;
procedure Obsolescent_Check (S : Source_Ptr) is
pragma Warnings (Off, S);
begin
null;
end Obsolescent_Check;
procedure Post_Scan is
begin
null;
end Post_Scan;
procedure Preprocess_Infile_Name is
Len : Natural;
First : Positive := 1;
Last : Natural;
Symbol : Name_Id;
Data : Symbol_Data;
begin
Get_Name_String (Infile_Name);
Len := Name_Len;
while File_Name_Buffer'Length < Len loop
Double_File_Name_Buffer;
end loop;
File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len);
while First < Len loop
if File_Name_Buffer (First) = '$' and then
Is_ASCII_Letter (File_Name_Buffer (First + 1))
then
Last := First + 1;
while Last < Len and then
Is_ASCII_Letter (File_Name_Buffer (Last + 1))
loop
Last := Last + 1;
end loop;
Name_Len := Last - First;
Name_Buffer (1 .. Name_Len) :=
File_Name_Buffer (First + 1 .. Last);
To_Lower (Name_Buffer (1 .. Name_Len));
Symbol := Name_Find;
for Index in 1 .. Symbol_Table.Last (Mapping) loop
Data := Mapping.Table (Index);
if Data.Symbol = Symbol then
if not Data.Is_A_String then
String_To_Name_Buffer (Data.Value);
declare
Sym_Len : constant Positive := Last - First + 1;
Offset : constant Integer := Name_Len - Sym_Len;
New_Len : constant Natural := Len + Offset;
begin
while New_Len > File_Name_Buffer'Length loop
Double_File_Name_Buffer;
end loop;
File_Name_Buffer (Last + 1 + Offset .. New_Len) :=
File_Name_Buffer (Last + 1 .. Len);
Len := New_Len;
Last := Last + Offset;
File_Name_Buffer (First .. Last) :=
Name_Buffer (1 .. Name_Len);
end;
end if;
exit;
end if;
end loop;
First := Last + 1;
else
First := First + 1;
end if;
end loop;
Get_Name_String (Output_Directory);
Add_Char_To_Name_Buffer (Directory_Separator);
Add_Str_To_Name_Buffer (File_Name_Buffer (1 .. Len));
Outfile_Name := Name_Find;
end Preprocess_Infile_Name;
procedure Process_Command_Line_Symbol_Definition (S : String) is
Data : Symbol_Data;
Symbol : Symbol_Id;
begin
Check_Command_Line_Symbol_Definition (S, Data);
Symbol := Index_Of (Data.Symbol);
if Symbol = No_Symbol then
Symbol_Table.Increment_Last (Mapping);
Symbol := Symbol_Table.Last (Mapping);
end if;
Mapping.Table (Symbol) := Data;
end Process_Command_Line_Symbol_Definition;
procedure Process_Files is
procedure Process_One_File;
procedure Recursive_Process (In_Dir : String; Out_Dir : String);
procedure Process_One_File is
Infile : Source_File_Index;
begin
begin
Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name));
exception
when others =>
Fail
("unable to create output file """,
Get_Name_String (Outfile_Name), """");
end;
Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name));
if Infile = No_Source_File then
Fail ("unable to find input file """,
Get_Name_String (Infile_Name), """");
end if;
Sinput.Main_Source_File := Infile;
Scanner.Initialize_Scanner (No_Unit, Infile);
if Source_Ref_Pragma then
Put_Line (Outfile.all, "pragma Source_Reference (1, """ &
Get_Name_String (Sinput.File_Name (Infile)) &
""");");
end if;
Prep.Preprocess;
if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then
Errutil.Finalize (Source_Type => "input");
end if;
if Err_Vars.Total_Errors_Detected > 0 then
if Outfile /= Standard_Output then
Delete (Text_Outfile);
end if;
Errutil.Finalize (Source_Type => "input");
OS_Exit (0);
elsif Outfile /= Standard_Output then
Close (Text_Outfile);
end if;
end Process_One_File;
procedure Recursive_Process (In_Dir : String; Out_Dir : String) is
Dir_In : Dir_Type;
Name : String (1 .. 255);
Last : Natural;
In_Dir_Name : Name_Id;
Out_Dir_Name : Name_Id;
procedure Set_Directory_Names;
procedure Set_Directory_Names is
begin
Input_Directory := In_Dir_Name;
Output_Directory := Out_Dir_Name;
end Set_Directory_Names;
begin
begin
Open (Dir_In, In_Dir);
exception
when Directory_Error =>
Fail ("could not read directory " & In_Dir);
end;
Name_Len := In_Dir'Length;
Name_Buffer (1 .. Name_Len) := In_Dir;
In_Dir_Name := Name_Find;
Name_Len := Out_Dir'Length;
Name_Buffer (1 .. Name_Len) := Out_Dir;
Out_Dir_Name := Name_Find;
Set_Directory_Names;
loop
Read (Dir_In, Name, Last);
exit when Last = 0;
if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
declare
Input : constant String :=
In_Dir & Directory_Separator & Name (1 .. Last);
Output : constant String :=
Out_Dir & Directory_Separator & Name (1 .. Last);
begin
if Is_Regular_File (Input) then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
Infile_Name := Name_Find;
Preprocess_Infile_Name;
Name_Len := Input'Length;
Name_Buffer (1 .. Name_Len) := Input;
Infile_Name := Name_Find;
Process_One_File;
elsif Is_Directory (Input) then
if not Is_Directory (Output) then
begin
Make_Dir (Dir_Name => Output);
exception
when Directory_Error =>
Fail ("could not create directory """,
Output, """");
end;
end if;
Recursive_Process (Input, Output);
Set_Directory_Names;
end if;
end;
end if;
end loop;
end Recursive_Process;
begin
if Output_Directory = No_Name then
if Is_Directory (Get_Name_String (Infile_Name)) then
Fail ("input file """ & Get_Name_String (Infile_Name) &
""" is a directory");
end if;
Process_One_File;
elsif Input_Directory = No_Name then
Preprocess_Infile_Name;
Process_One_File;
else
Recursive_Process
(In_Dir => Get_Name_String (Input_Directory),
Out_Dir => Get_Name_String (Output_Directory));
end if;
end Process_Files;
procedure Put_Char_To_Outfile (C : Character) is
begin
Put (Outfile.all, C);
end Put_Char_To_Outfile;
procedure Scan_Command_Line is
Switch : Character;
begin
loop
begin
Switch := GNAT.Command_Line.Getopt ("D: b c r s u v");
case Switch is
when ASCII.NUL =>
exit;
when 'D' =>
Process_Command_Line_Symbol_Definition
(S => GNAT.Command_Line.Parameter);
when 'b' =>
Opt.Blank_Deleted_Lines := True;
when 'c' =>
Opt.Comment_Deleted_Lines := True;
when 'r' =>
Source_Ref_Pragma := True;
when 's' =>
Opt.List_Preprocessing_Symbols := True;
when 'u' =>
Opt.Undefined_Symbols_Are_False := True;
when 'v' =>
Opt.Verbose_Mode := True;
when others =>
Fail ("Invalid Switch: -" & Switch);
end case;
exception
when GNAT.Command_Line.Invalid_Switch =>
Write_Str ("Invalid Switch: -");
Write_Line (GNAT.Command_Line.Full_Switch);
Usage;
OS_Exit (1);
end;
end loop;
loop
declare
S : constant String := GNAT.Command_Line.Get_Argument;
begin
exit when S'Length = 0;
Name_Len := S'Length;
Name_Buffer (1 .. Name_Len) := S;
if Infile_Name = No_Name then
Infile_Name := Name_Find;
elsif Outfile_Name = No_Name then
Outfile_Name := Name_Find;
elsif Deffile_Name = No_Name then
Deffile_Name := Name_Find;
else
Fail ("too many arguments specifed");
end if;
end;
end loop;
end Scan_Command_Line;
procedure Usage is
begin
Display_Copyright;
Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " &
"infile outfile [deffile]");
Write_Eol;
Write_Line (" infile Name of the input file");
Write_Line (" outfile Name of the output file");
Write_Line (" deffile Name of the definition file");
Write_Eol;
Write_Line ("gnatprep switches:");
Write_Line (" -b Replace preprocessor lines by blank lines");
Write_Line (" -c Keep preprocessor lines as comments");
Write_Line (" -D Associate symbol with value");
Write_Line (" -r Generate Source_Reference pragma");
Write_Line (" -s Print a sorted list of symbol names and values");
Write_Line (" -u Treat undefined symbols as FALSE");
Write_Line (" -v Verbose mode");
Write_Eol;
end Usage;
end GPrep;