OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [switch.adb] - Blame information for rev 843

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                               S W I T C H                                --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2009, 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_Version --
103
   ---------------------
104
 
105
   procedure Display_Version
106
     (Tool_Name      : String;
107
      Initial_Year   : String;
108
      Version_String : String := Gnatvsn.Gnat_Version_String)
109
   is
110
   begin
111
      Write_Str (Tool_Name);
112
      Write_Char (' ');
113
      Write_Str (Version_String);
114
      Write_Eol;
115
 
116
      Write_Str ("Copyright (C) ");
117
      Write_Str (Initial_Year);
118
      Write_Char ('-');
119
      Write_Str (Gnatvsn.Current_Year);
120
      Write_Str (", ");
121
      Write_Str (Gnatvsn.Copyright_Holder);
122
      Write_Eol;
123
   end Display_Version;
124
 
125
   -------------------------
126
   -- Is_Front_End_Switch --
127
   -------------------------
128
 
129
   function Is_Front_End_Switch (Switch_Chars : String) return Boolean is
130
      Ptr : constant Positive := Switch_Chars'First;
131
   begin
132
      return Is_Switch (Switch_Chars)
133
        and then
134
          (Switch_Chars (Ptr + 1) = 'I'
135
            or else (Switch_Chars'Length >= 5
136
                      and then Switch_Chars (Ptr + 1 .. Ptr + 4) = "gnat")
137
            or else (Switch_Chars'Length >= 5
138
                      and then Switch_Chars (Ptr + 2 .. Ptr + 4) = "RTS"));
139
   end Is_Front_End_Switch;
140
 
141
   ----------------------------
142
   -- Is_Internal_GCC_Switch --
143
   ----------------------------
144
 
145
   function Is_Internal_GCC_Switch (Switch_Chars : String) return Boolean is
146
      First : constant Natural := Switch_Chars'First + 1;
147
      Last  : constant Natural := Switch_Last (Switch_Chars);
148
   begin
149
      return Is_Switch (Switch_Chars)
150
        and then
151
          (Switch_Chars (First .. Last) = "-param"        or else
152
           Switch_Chars (First .. Last) = "dumpbase"      or else
153
           Switch_Chars (First .. Last) = "auxbase-strip" or else
154
           Switch_Chars (First .. Last) = "auxbase");
155
   end Is_Internal_GCC_Switch;
156
 
157
   ---------------
158
   -- Is_Switch --
159
   ---------------
160
 
161
   function Is_Switch (Switch_Chars : String) return Boolean is
162
   begin
163
      return Switch_Chars'Length > 1
164
        and then Switch_Chars (Switch_Chars'First) = '-';
165
   end Is_Switch;
166
 
167
   -----------------
168
   -- Switch_last --
169
   -----------------
170
 
171
   function Switch_Last (Switch_Chars : String) return Natural is
172
      Last : constant Natural := Switch_Chars'Last;
173
   begin
174
      if Last >= Switch_Chars'First
175
        and then Switch_Chars (Last) = ASCII.NUL
176
      then
177
         return Last - 1;
178
      else
179
         return Last;
180
      end if;
181
   end Switch_Last;
182
 
183
   -----------------
184
   -- Nat_Present --
185
   -----------------
186
 
187
   function Nat_Present
188
     (Switch_Chars : String;
189
      Max          : Integer;
190
      Ptr          : Integer) return Boolean
191
   is
192
   begin
193
      return (Ptr <= Max
194
                and then Switch_Chars (Ptr) in '0' .. '9')
195
        or else
196
             (Ptr < Max
197
                and then Switch_Chars (Ptr) = '='
198
                and then Switch_Chars (Ptr + 1) in '0' .. '9');
199
   end Nat_Present;
200
 
201
   --------------
202
   -- Scan_Nat --
203
   --------------
204
 
205
   procedure Scan_Nat
206
     (Switch_Chars : String;
207
      Max          : Integer;
208
      Ptr          : in out Integer;
209
      Result       : out Nat;
210
      Switch       : Character)
211
   is
212
   begin
213
      Result := 0;
214
 
215
      if not Nat_Present (Switch_Chars, Max, Ptr) then
216
         Osint.Fail ("missing numeric value for switch: " & Switch);
217
      end if;
218
 
219
      if Switch_Chars (Ptr) = '=' then
220
         Ptr := Ptr + 1;
221
      end if;
222
 
223
      while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop
224
         Result :=
225
           Result * 10 +
226
             Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0');
227
         Ptr := Ptr + 1;
228
 
229
         if Result > Switch_Max_Value then
230
            Osint.Fail ("numeric value out of range for switch: " & Switch);
231
         end if;
232
      end loop;
233
   end Scan_Nat;
234
 
235
   --------------
236
   -- Scan_Pos --
237
   --------------
238
 
239
   procedure Scan_Pos
240
     (Switch_Chars : String;
241
      Max          : Integer;
242
      Ptr          : in out Integer;
243
      Result       : out Pos;
244
      Switch       : Character)
245
   is
246
      Temp : Nat;
247
 
248
   begin
249
      Scan_Nat (Switch_Chars, Max, Ptr, Temp, Switch);
250
 
251
      if Temp = 0 then
252
         Osint.Fail ("numeric value out of range for switch: " & Switch);
253
      end if;
254
 
255
      Result := Temp;
256
   end Scan_Pos;
257
 
258
end Switch;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.