273 lines
8.3 KiB
Ada
273 lines
8.3 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- S W I T C H --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1992-2020, 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) = "dumpdir" or else
|
|
Switch_Chars (First .. Last) = "dumpbase" or else
|
|
Switch_Chars (First .. Last) = "dumpbase-ext");
|
|
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;
|