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;