|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S W I T C H --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
|
111
|
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
|
|
|
26 with Osint; use Osint;
|
|
|
27 with Output; use Output;
|
|
|
28
|
|
|
29 package 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 -----------------
|
|
131
|
182 -- Switch_Last --
|
|
111
|
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
|
|
|
272 end Switch;
|
