1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S W I T C H -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Osint; use Osint; 27with Output; use Output; 28 29package body Switch is 30 31 ---------------- 32 -- Bad_Switch -- 33 ---------------- 34 35 procedure Bad_Switch (Switch : Character) is 36 begin 37 Osint.Fail ("invalid switch: " & Switch); 38 end Bad_Switch; 39 40 procedure Bad_Switch (Switch : String) is 41 begin 42 Osint.Fail ("invalid switch: " & Switch); 43 end Bad_Switch; 44 45 ------------------------------ 46 -- Check_Version_And_Help_G -- 47 ------------------------------ 48 49 procedure Check_Version_And_Help_G 50 (Tool_Name : String; 51 Initial_Year : String; 52 Version_String : String := Gnatvsn.Gnat_Version_String) 53 is 54 Version_Switch_Present : Boolean := False; 55 Help_Switch_Present : Boolean := False; 56 Next_Arg : Natural; 57 58 begin 59 -- First check for --version or --help 60 61 Next_Arg := 1; 62 while Next_Arg < Arg_Count loop 63 declare 64 Next_Argv : String (1 .. Len_Arg (Next_Arg)); 65 begin 66 Fill_Arg (Next_Argv'Address, Next_Arg); 67 68 if Next_Argv = Version_Switch then 69 Version_Switch_Present := True; 70 71 elsif Next_Argv = Help_Switch then 72 Help_Switch_Present := True; 73 end if; 74 75 Next_Arg := Next_Arg + 1; 76 end; 77 end loop; 78 79 -- If --version was used, display version and exit 80 81 if Version_Switch_Present then 82 Set_Standard_Output; 83 Display_Version (Tool_Name, Initial_Year, Version_String); 84 Write_Str (Gnatvsn.Gnat_Free_Software); 85 Write_Eol; 86 Write_Eol; 87 Exit_Program (E_Success); 88 end if; 89 90 -- If --help was used, display help and exit 91 92 if Help_Switch_Present then 93 Set_Standard_Output; 94 Usage; 95 Write_Eol; 96 Write_Line ("Report bugs to report@adacore.com"); 97 Exit_Program (E_Success); 98 end if; 99 end Check_Version_And_Help_G; 100 101 ------------------------------------ 102 -- Display_Usage_Version_And_Help -- 103 ------------------------------------ 104 105 procedure Display_Usage_Version_And_Help is 106 begin 107 Write_Str (" --version Display version and exit"); 108 Write_Eol; 109 110 Write_Str (" --help Display usage and exit"); 111 Write_Eol; 112 Write_Eol; 113 end Display_Usage_Version_And_Help; 114 115 --------------------- 116 -- Display_Version -- 117 --------------------- 118 119 procedure Display_Version 120 (Tool_Name : String; 121 Initial_Year : String; 122 Version_String : String := Gnatvsn.Gnat_Version_String) 123 is 124 begin 125 Write_Str (Tool_Name); 126 Write_Char (' '); 127 Write_Str (Version_String); 128 Write_Eol; 129 130 Write_Str ("Copyright (C) "); 131 Write_Str (Initial_Year); 132 Write_Char ('-'); 133 Write_Str (Gnatvsn.Current_Year); 134 Write_Str (", "); 135 Write_Str (Gnatvsn.Copyright_Holder); 136 Write_Eol; 137 end Display_Version; 138 139 ------------------------- 140 -- Is_Front_End_Switch -- 141 ------------------------- 142 143 function Is_Front_End_Switch (Switch_Chars : String) return Boolean is 144 Ptr : constant Positive := Switch_Chars'First; 145 begin 146 return Is_Switch (Switch_Chars) 147 and then 148 (Switch_Chars (Ptr + 1) = 'I' 149 or else (Switch_Chars'Length >= 5 150 and then Switch_Chars (Ptr + 1 .. Ptr + 4) = "gnat") 151 or else (Switch_Chars'Length >= 5 152 and then Switch_Chars (Ptr + 2 .. Ptr + 4) = "RTS")); 153 end Is_Front_End_Switch; 154 155 ---------------------------- 156 -- Is_Internal_GCC_Switch -- 157 ---------------------------- 158 159 function Is_Internal_GCC_Switch (Switch_Chars : String) return Boolean is 160 First : constant Natural := Switch_Chars'First + 1; 161 Last : constant Natural := Switch_Last (Switch_Chars); 162 begin 163 return Is_Switch (Switch_Chars) 164 and then 165 (Switch_Chars (First .. Last) = "-param" or else 166 Switch_Chars (First .. Last) = "dumpbase" or else 167 Switch_Chars (First .. Last) = "auxbase-strip" or else 168 Switch_Chars (First .. Last) = "auxbase"); 169 end Is_Internal_GCC_Switch; 170 171 --------------- 172 -- Is_Switch -- 173 --------------- 174 175 function Is_Switch (Switch_Chars : String) return Boolean is 176 begin 177 return Switch_Chars'Length > 1 178 and then Switch_Chars (Switch_Chars'First) = '-'; 179 end Is_Switch; 180 181 ----------------- 182 -- Switch_last -- 183 ----------------- 184 185 function Switch_Last (Switch_Chars : String) return Natural is 186 Last : constant Natural := Switch_Chars'Last; 187 begin 188 if Last >= Switch_Chars'First 189 and then Switch_Chars (Last) = ASCII.NUL 190 then 191 return Last - 1; 192 else 193 return Last; 194 end if; 195 end Switch_Last; 196 197 ----------------- 198 -- Nat_Present -- 199 ----------------- 200 201 function Nat_Present 202 (Switch_Chars : String; 203 Max : Integer; 204 Ptr : Integer) return Boolean 205 is 206 begin 207 return (Ptr <= Max 208 and then Switch_Chars (Ptr) in '0' .. '9') 209 or else 210 (Ptr < Max 211 and then Switch_Chars (Ptr) = '=' 212 and then Switch_Chars (Ptr + 1) in '0' .. '9'); 213 end Nat_Present; 214 215 -------------- 216 -- Scan_Nat -- 217 -------------- 218 219 procedure Scan_Nat 220 (Switch_Chars : String; 221 Max : Integer; 222 Ptr : in out Integer; 223 Result : out Nat; 224 Switch : Character) 225 is 226 begin 227 Result := 0; 228 229 if not Nat_Present (Switch_Chars, Max, Ptr) then 230 Osint.Fail ("missing numeric value for switch: " & Switch); 231 end if; 232 233 if Switch_Chars (Ptr) = '=' then 234 Ptr := Ptr + 1; 235 end if; 236 237 while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop 238 Result := 239 Result * 10 + 240 Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0'); 241 Ptr := Ptr + 1; 242 243 if Result > Switch_Max_Value then 244 Osint.Fail ("numeric value out of range for switch: " & Switch); 245 end if; 246 end loop; 247 end Scan_Nat; 248 249 -------------- 250 -- Scan_Pos -- 251 -------------- 252 253 procedure Scan_Pos 254 (Switch_Chars : String; 255 Max : Integer; 256 Ptr : in out Integer; 257 Result : out Pos; 258 Switch : Character) 259 is 260 Temp : Nat; 261 262 begin 263 Scan_Nat (Switch_Chars, Max, Ptr, Temp, Switch); 264 265 if Temp = 0 then 266 Osint.Fail ("numeric value out of range for switch: " & Switch); 267 end if; 268 269 Result := Temp; 270 end Scan_Pos; 271 272end Switch; 273