Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                               S W I T C H                                --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2011, 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 Osint;  use Osint;

with Output; use Output;

package body Switch is

   ----------------

   -- Bad_Switch --

   ----------------

   procedure Bad_Switch (Switch : Character) is

   begin

      Osint.Fail ("invalid switch: " & Switch);

   end Bad_Switch;

   procedure Bad_Switch (Switch : String) is

   begin

      Osint.Fail ("invalid switch: " & Switch);

   end Bad_Switch;

   ------------------------------

   -- Check_Version_And_Help_G --

   ------------------------------

   procedure Check_Version_And_Help_G

     (Tool_Name      : String;

      Initial_Year   : String;

      Version_String : String := Gnatvsn.Gnat_Version_String)

   is

      Version_Switch_Present : Boolean := False;

      Help_Switch_Present    : Boolean := False;

      Next_Arg               : Natural;

   begin

      --  First check for --version or --help

      Next_Arg := 1;

      while Next_Arg < Arg_Count loop

         declare

            Next_Argv : String (1 .. Len_Arg (Next_Arg));

         begin

            Fill_Arg (Next_Argv'Address, Next_Arg);

            if Next_Argv = Version_Switch then

               Version_Switch_Present := True;

            elsif Next_Argv = Help_Switch then

               Help_Switch_Present := True;

            end if;

            Next_Arg := Next_Arg + 1;

         end;

      end loop;

      --  If --version was used, display version and exit

      if Version_Switch_Present then

         Set_Standard_Output;

         Display_Version (Tool_Name, Initial_Year, Version_String);

         Write_Str (Gnatvsn.Gnat_Free_Software);

         Write_Eol;

         Write_Eol;

         Exit_Program (E_Success);

      end if;

      --  If --help was used, display help and exit

      if Help_Switch_Present then

         Set_Standard_Output;

         Usage;

         Write_Eol;

         Write_Line ("Report bugs to report@adacore.com");

         Exit_Program (E_Success);

      end if;

   end Check_Version_And_Help_G;

   ------------------------------------

   -- Display_Usage_Version_And_Help --

   ------------------------------------

   procedure Display_Usage_Version_And_Help is

   begin

      Write_Str ("  --version   Display version and exit");

      Write_Eol;

      Write_Str ("  --help      Display usage and exit");

      Write_Eol;

      Write_Eol;

   end Display_Usage_Version_And_Help;

   ---------------------

   -- Display_Version --

   ---------------------

   procedure Display_Version

     (Tool_Name      : String;

      Initial_Year   : String;

      Version_String : String := Gnatvsn.Gnat_Version_String)

   is

   begin

      Write_Str (Tool_Name);

      Write_Char (' ');

      Write_Str (Version_String);

      Write_Eol;

      Write_Str ("Copyright (C) ");

      Write_Str (Initial_Year);

      Write_Char ('-');

      Write_Str (Gnatvsn.Current_Year);

      Write_Str (", ");

      Write_Str (Gnatvsn.Copyright_Holder);

      Write_Eol;

   end Display_Version;

   -------------------------

   -- Is_Front_End_Switch --

   -------------------------

   function Is_Front_End_Switch (Switch_Chars : String) return Boolean is

      Ptr : constant Positive := Switch_Chars'First;

   begin

      return Is_Switch (Switch_Chars)

        and then

          (Switch_Chars (Ptr + 1) = 'I'

            or else (Switch_Chars'Length >= 5

                      and then Switch_Chars (Ptr + 1 .. Ptr + 4) = "gnat")

            or else (Switch_Chars'Length >= 5

                      and then Switch_Chars (Ptr + 2 .. Ptr + 4) = "RTS"));

   end Is_Front_End_Switch;

   ----------------------------

   -- Is_Internal_GCC_Switch --

   ----------------------------

   function Is_Internal_GCC_Switch (Switch_Chars : String) return Boolean is

      First : constant Natural := Switch_Chars'First + 1;

      Last  : constant Natural := Switch_Last (Switch_Chars);

   begin

      return Is_Switch (Switch_Chars)

        and then

          (Switch_Chars (First .. Last) = "-param"        or else

           Switch_Chars (First .. Last) = "dumpbase"      or else

           Switch_Chars (First .. Last) = "auxbase-strip" or else

           Switch_Chars (First .. Last) = "auxbase");

   end Is_Internal_GCC_Switch;

   ---------------

   -- Is_Switch --

   ---------------

   function Is_Switch (Switch_Chars : String) return Boolean is

   begin

      return Switch_Chars'Length > 1

        and then Switch_Chars (Switch_Chars'First) = '-';

   end Is_Switch;

   -----------------

   -- Switch_last --

   -----------------

   function Switch_Last (Switch_Chars : String) return Natural is

      Last : constant Natural := Switch_Chars'Last;

   begin

      if Last >= Switch_Chars'First

        and then Switch_Chars (Last) = ASCII.NUL

      then

         return Last - 1;

      else

         return Last;

      end if;

   end Switch_Last;

   -----------------

   -- Nat_Present --

   -----------------

   function Nat_Present

     (Switch_Chars : String;

      Max          : Integer;

      Ptr          : Integer) return Boolean

   is

   begin

      return (Ptr <= Max

                and then Switch_Chars (Ptr) in '0' .. '9')

        or else

             (Ptr < Max

                and then Switch_Chars (Ptr) = '='

                and then Switch_Chars (Ptr + 1) in '0' .. '9');

   end Nat_Present;

   --------------

   -- Scan_Nat --

   --------------

   procedure Scan_Nat

     (Switch_Chars : String;

      Max          : Integer;

      Ptr          : in out Integer;

      Result       : out Nat;

      Switch       : Character)

   is

   begin

      Result := 0;

      if not Nat_Present (Switch_Chars, Max, Ptr) then

         Osint.Fail ("missing numeric value for switch: " & Switch);

      end if;

      if Switch_Chars (Ptr) = '=' then

         Ptr := Ptr + 1;

      end if;

      while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop

         Result :=

           Result * 10 +

             Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0');

         Ptr := Ptr + 1;

         if Result > Switch_Max_Value then

            Osint.Fail ("numeric value out of range for switch: " & Switch);

         end if;

      end loop;

   end Scan_Nat;

   --------------

   -- Scan_Pos --

   --------------

   procedure Scan_Pos

     (Switch_Chars : String;

      Max          : Integer;

      Ptr          : in out Integer;

      Result       : out Pos;

      Switch       : Character)

   is

      Temp : Nat;

   begin

      Scan_Nat (Switch_Chars, Max, Ptr, Temp, Switch);

      if Temp = 0 then

         Osint.Fail ("numeric value out of range for switch: " & Switch);

      end if;

      Result := Temp;

   end Scan_Pos;

end Switch;