File : switch.adb
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-2011, 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
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 -----------------
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
272 end Switch;