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
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