view gcc/ada/switch.adb @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
line wrap: on
line source

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                               S W I T C H                                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2019, 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;