OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [switch.adb] - Rev 706

Compare with Previous | Blame | View Log

------------------------------------------------------------------------------
--                                                                          --
--                         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;
 

Compare with Previous | Blame | View Log

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.