aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.4.0/gcc/ada/gprep.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.4.0/gcc/ada/gprep.adb')
-rw-r--r--gcc-4.4.0/gcc/ada/gprep.adb816
1 files changed, 816 insertions, 0 deletions
diff --git a/gcc-4.4.0/gcc/ada/gprep.adb b/gcc-4.4.0/gcc/ada/gprep.adb
new file mode 100644
index 000000000..44633b9c9
--- /dev/null
+++ b/gcc-4.4.0/gcc/ada/gprep.adb
@@ -0,0 +1,816 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G P R E P --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2002-2008, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Csets;
+with Err_Vars; use Err_Vars;
+with Errutil;
+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 Switch; use Switch;
+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 System.OS_Lib; use System.OS_Lib;
+
+package body GPrep is
+
+ Copyright_Displayed : Boolean := False;
+ -- Used to prevent multiple displays of the copyright notice
+
+ ------------------------
+ -- Argument Line Data --
+ ------------------------
+
+ Infile_Name : Name_Id := No_Name;
+ Outfile_Name : Name_Id := No_Name;
+ Deffile_Name : Name_Id := No_Name;
+
+ Output_Directory : Name_Id := No_Name;
+ -- Used when the specified output is an existing directory
+
+ Input_Directory : Name_Id := No_Name;
+ -- Used when the specified input and output are existing directories
+
+ Source_Ref_Pragma : Boolean := False;
+ -- Record command line options (set if -r switch set)
+
+ 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);
+ -- A buffer to build output file names from input file names
+
+ -----------------
+ -- Subprograms --
+ -----------------
+
+ procedure Display_Copyright;
+ -- Display the copyright notice
+
+ procedure Obsolescent_Check (S : Source_Ptr);
+ -- Null procedure, needed by instantiation of Scng below
+
+ procedure Post_Scan;
+ -- Null procedure, needed by instantiation of Scng below
+
+ 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);
+ -- The scanner for the preprocessor
+
+ function Is_ASCII_Letter (C : Character) return Boolean;
+ -- True if C is in 'a' .. 'z' or in 'A' .. 'Z'
+
+ procedure Double_File_Name_Buffer;
+ -- Double the size of the file name buffer
+
+ procedure Preprocess_Infile_Name;
+ -- When the specified output is a directory, preprocess the infile name
+ -- for symbol substitution, to get the output file name.
+
+ procedure Process_Files;
+ -- Process the single input file or all the files in the directory tree
+ -- rooted at the input directory.
+
+ procedure Process_Command_Line_Symbol_Definition (S : String);
+ -- Process a -D switch on the command line
+
+ procedure Put_Char_To_Outfile (C : Character);
+ -- Output one character to the output file. Used to initialize the
+ -- preprocessor.
+
+ procedure New_EOL_To_Outfile;
+ -- Output a new line to the output file. Used to initialize the
+ -- preprocessor.
+
+ procedure Scan_Command_Line;
+ -- Scan the switches and the file names
+
+ procedure Usage;
+ -- Display the usage
+
+ -----------------------
+ -- Display_Copyright --
+ -----------------------
+
+ procedure Display_Copyright is
+ begin
+ if not Copyright_Displayed then
+ Display_Version ("GNAT Preprocessor", "1996");
+ Copyright_Displayed := True;
+ end if;
+ end Display_Copyright;
+
+ -----------------------------
+ -- Double_File_Name_Buffer --
+ -----------------------------
+
+ 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;
+
+ --------------
+ -- Gnatprep --
+ --------------
+
+ procedure Gnatprep is
+ begin
+ -- Do some initializations (order is important here!)
+
+ Csets.Initialize;
+ Namet.Initialize;
+ Snames.Initialize;
+ Stringt.Initialize;
+
+ -- Initialize the preprocessor
+
+ 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);
+
+ -- Set the scanner characteristics for the preprocessor
+
+ Scanner.Set_Special_Character ('#');
+ Scanner.Set_Special_Character ('$');
+ Scanner.Set_End_Of_Line_As_Token (True);
+
+ -- Initialize the mapping table of symbols to values
+
+ Prep.Symbol_Table.Init (Prep.Mapping);
+
+ -- Parse the switches and arguments
+
+ Scan_Command_Line;
+
+ if Opt.Verbose_Mode then
+ Display_Copyright;
+ end if;
+
+ -- Test we had all the arguments needed
+
+ if Infile_Name = No_Name then
+
+ -- No input file specified, just output the usage and exit
+
+ Usage;
+ return;
+
+ elsif Outfile_Name = No_Name then
+
+ -- No output file specified, just output the usage and exit
+
+ Usage;
+ return;
+ end if;
+
+ -- If a pragma Source_File_Name, we need to keep line numbers. So, if
+ -- the deleted lines are not put as comment, we must output them as
+ -- blank lines.
+
+ if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
+ Opt.Blank_Deleted_Lines := True;
+ end if;
+
+ -- If we have a definition file, parse it
+
+ if Deffile_Name /= No_Name then
+ declare
+ Deffile : Source_File_Index;
+
+ begin
+ Errutil.Initialize;
+ Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name));
+
+ -- Set Main_Source_File to the definition file for the benefit of
+ -- Errutil.Finalize.
+
+ 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 (Deffile);
+
+ Prep.Parse_Def_File;
+ end;
+ end if;
+
+ -- If there are errors in the definition file, output them and exit
+
+ if Total_Errors_Detected > 0 then
+ Errutil.Finalize (Source_Type => "definition");
+ Fail ("errors in definition file """,
+ Get_Name_String (Deffile_Name), """");
+ end if;
+
+ -- If -s switch was specified, print a sorted list of symbol names and
+ -- values, if any.
+
+ if Opt.List_Preprocessing_Symbols then
+ Prep.List_Symbols (Foreword => "");
+ end if;
+
+ Output_Directory := No_Name;
+ Input_Directory := No_Name;
+
+ -- Check if the specified output is an existing directory
+
+ if Is_Directory (Get_Name_String (Outfile_Name)) then
+ Output_Directory := Outfile_Name;
+
+ -- As the output is an existing directory, check if the input too
+ -- is a directory.
+
+ if Is_Directory (Get_Name_String (Infile_Name)) then
+ Input_Directory := Infile_Name;
+ end if;
+ end if;
+
+ -- And process the single input or the files in the directory tree
+ -- rooted at the input directory.
+
+ Process_Files;
+ end Gnatprep;
+
+ ---------------------
+ -- Is_ASCII_Letter --
+ ---------------------
+
+ 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;
+
+ ------------------------
+ -- New_EOL_To_Outfile --
+ ------------------------
+
+ procedure New_EOL_To_Outfile is
+ begin
+ New_Line (Outfile.all);
+ end New_EOL_To_Outfile;
+
+ -----------------------
+ -- Obsolescent_Check --
+ -----------------------
+
+ procedure Obsolescent_Check (S : Source_Ptr) is
+ pragma Warnings (Off, S);
+ begin
+ null;
+ end Obsolescent_Check;
+
+ ---------------
+ -- Post_Scan --
+ ---------------
+
+ procedure Post_Scan is
+ begin
+ null;
+ end Post_Scan;
+
+ ----------------------------
+ -- Preprocess_Infile_Name --
+ ----------------------------
+
+ procedure Preprocess_Infile_Name is
+ Len : Natural;
+ First : Positive;
+ Last : Natural;
+ Symbol : Name_Id;
+ Data : Symbol_Data;
+
+ begin
+ -- Initialize the buffer with the name of the input file
+
+ 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);
+
+ -- Look for possible symbols in the file name
+
+ First := 1;
+ while First < Len loop
+
+ -- A symbol starts with a dollar sign followed by a letter
+
+ if File_Name_Buffer (First) = '$' and then
+ Is_ASCII_Letter (File_Name_Buffer (First + 1))
+ then
+ Last := First + 1;
+
+ -- Find the last letter of the symbol
+
+ while Last < Len and then
+ Is_ASCII_Letter (File_Name_Buffer (Last + 1))
+ loop
+ Last := Last + 1;
+ end loop;
+
+ -- Get the symbol name id
+
+ 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;
+
+ -- And look for this symbol name in the symbol table
+
+ for Index in 1 .. Symbol_Table.Last (Mapping) loop
+ Data := Mapping.Table (Index);
+
+ if Data.Symbol = Symbol then
+
+ -- We found the symbol. If its value is not a string,
+ -- replace the symbol in the file name with the value of
+ -- the symbol.
+
+ 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;
+
+ -- Skip over the symbol name or its value: we are not checking
+ -- for another symbol name in the value.
+
+ First := Last + 1;
+
+ else
+ First := First + 1;
+ end if;
+ end loop;
+
+ -- We now have the output file name in the buffer. Get the output
+ -- path and put it in Outfile_Name.
+
+ 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;
+
+ --------------------------------------------
+ -- Process_Command_Line_Symbol_Definition --
+ --------------------------------------------
+
+ procedure Process_Command_Line_Symbol_Definition (S : String) is
+ Data : Symbol_Data;
+ Symbol : Symbol_Id;
+
+ begin
+ -- Check the symbol definition and get the symbol and its value.
+ -- Fail if symbol definition is illegal.
+
+ Check_Command_Line_Symbol_Definition (S, Data);
+
+ Symbol := Index_Of (Data.Symbol);
+
+ -- If symbol does not already exist, create a new entry in the mapping
+ -- table.
+
+ 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;
+
+ -------------------
+ -- Process_Files --
+ -------------------
+
+ procedure Process_Files is
+
+ procedure Process_One_File;
+ -- Process input file Infile_Name and put the result in file
+ -- Outfile_Name.
+
+ procedure Recursive_Process (In_Dir : String; Out_Dir : String);
+ -- Process recursively files in In_Dir. Results go to Out_Dir
+
+ ----------------------
+ -- Process_One_File --
+ ----------------------
+
+ procedure Process_One_File is
+ Infile : Source_File_Index;
+
+ Modified : Boolean;
+ pragma Warnings (Off, Modified);
+
+ begin
+ -- Create the output file (fails if this does not work)
+
+ 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;
+
+ -- Load the input file
+
+ 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;
+
+ -- Set Main_Source_File to the input file for the benefit of
+ -- Errutil.Finalize.
+
+ Sinput.Main_Source_File := Infile;
+
+ Scanner.Initialize_Scanner (Infile);
+
+ -- Output the pragma Source_Reference if asked to
+
+ if Source_Ref_Pragma then
+ Put_Line
+ (Outfile.all,
+ "pragma Source_Reference (1, """ &
+ Get_Name_String (Sinput.Full_File_Name (Infile)) & """);");
+ end if;
+
+ -- Preprocess the input file
+
+ Prep.Preprocess (Modified);
+
+ -- In verbose mode, if there is no error, report it
+
+ if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then
+ Errutil.Finalize (Source_Type => "input");
+ end if;
+
+ -- If we had some errors, delete the output file, and report them
+
+ 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);
+
+ -- Otherwise, close the output file, and we are done
+
+ elsif Outfile /= Standard_Output then
+ Close (Text_Outfile);
+ end if;
+ end Process_One_File;
+
+ -----------------------
+ -- Recursive_Process --
+ -----------------------
+
+ 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;
+ -- Establish or reestablish the current input and output directories
+
+ -------------------------
+ -- Set_Directory_Names --
+ -------------------------
+
+ procedure Set_Directory_Names is
+ begin
+ Input_Directory := In_Dir_Name;
+ Output_Directory := Out_Dir_Name;
+ end Set_Directory_Names;
+
+ -- Start of processing for Recursive_Process
+
+ begin
+ -- Open the current input directory
+
+ begin
+ Open (Dir_In, In_Dir);
+
+ exception
+ when Directory_Error =>
+ Fail ("could not read directory " & In_Dir);
+ end;
+
+ -- Set the new input and output directory names
+
+ 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;
+
+ -- Traverse the input directory
+ 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 input is an ordinary file, process it
+
+ if Is_Regular_File (Input) then
+ -- First get the output file name
+
+ Name_Len := Last;
+ Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
+ Infile_Name := Name_Find;
+ Preprocess_Infile_Name;
+
+ -- Set the input file name and process the file
+
+ Name_Len := Input'Length;
+ Name_Buffer (1 .. Name_Len) := Input;
+ Infile_Name := Name_Find;
+ Process_One_File;
+
+ elsif Is_Directory (Input) then
+ -- Input is a directory. If the corresponding output
+ -- directory does not already exist, create it.
+
+ 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;
+
+ -- And process this new input directory
+
+ Recursive_Process (Input, Output);
+
+ -- Reestablish the input and output directory names
+ -- that have been modified by the recursive call.
+
+ Set_Directory_Names;
+ end if;
+ end;
+ end if;
+ end loop;
+ end Recursive_Process;
+
+ -- Start of processing for Process_Files
+
+ begin
+ if Output_Directory = No_Name then
+
+ -- If the output is not a directory, fail if the input is
+ -- an existing directory, to avoid possible problems.
+
+ if Is_Directory (Get_Name_String (Infile_Name)) then
+ Fail ("input file """ & Get_Name_String (Infile_Name) &
+ """ is a directory");
+ end if;
+
+ -- Just process the single input file
+
+ Process_One_File;
+
+ elsif Input_Directory = No_Name then
+
+ -- Get the output file name from the input file name, and process
+ -- the single input file.
+
+ Preprocess_Infile_Name;
+ Process_One_File;
+
+ else
+ -- Recursively process files in the directory tree rooted at the
+ -- input directory.
+
+ Recursive_Process
+ (In_Dir => Get_Name_String (Input_Directory),
+ Out_Dir => Get_Name_String (Output_Directory));
+ end if;
+ end Process_Files;
+
+ -------------------------
+ -- Put_Char_To_Outfile --
+ -------------------------
+
+ procedure Put_Char_To_Outfile (C : Character) is
+ begin
+ Put (Outfile.all, C);
+ end Put_Char_To_Outfile;
+
+ -----------------------
+ -- Scan_Command_Line --
+ -----------------------
+
+ procedure Scan_Command_Line is
+ Switch : Character;
+
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
+ -- Start of processing for Scan_Command_Line
+
+ begin
+ -- First check for --version or --help
+
+ Check_Version_And_Help ("GNATPREP", "1996");
+
+ -- Now scan the other switches
+
+ GNAT.Command_Line.Initialize_Option_Scan;
+
+ loop
+ begin
+ Switch := GNAT.Command_Line.Getopt ("D: b c 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 'C' =>
+ Opt.Replace_In_Comments := 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;
+
+ -- Get the file names
+
+ 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 specified");
+ end if;
+ end;
+ end loop;
+ end Scan_Command_Line;
+
+ -----------
+ -- Usage --
+ -----------
+
+ 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 (" -C Do symbol replacements within 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;