Subversion Repositories openrisc

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                                G P R E P                                 --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2002-2009, 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 --
   ------------------------
 
   Unix_Line_Terminators : Boolean := False;
   --  Set to True with option -T
 
   type String_Array is array (Boolean) of String_Access;
   Yes_No : constant String_Array :=
     (False => new String'("YES"),
      True  => new String'("NO"));
 
   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;
      Prep.Initialize;
 
      --  Initialize the preprocessor
 
      Prep.Setup_Hooks
        (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
              (File => Text_Outfile,
               Mode => Out_File,
               Name => Get_Name_String (Outfile_Name),
               Form => "Text_Translation=" &
                       Yes_No (Unix_Line_Terminators).all);
 
         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 T 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 'T' =>
                  Unix_Line_Terminators := 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 ("   -T  Use LF as line terminators");
      Write_Line ("   -u  Treat undefined symbols as FALSE");
      Write_Line ("   -v  Verbose mode");
      Write_Eol;
   end Usage;
 
end GPrep;