1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2002 Free Software Foundation, Inc. --
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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Debug
; use Debug
;
28 with Osint
; use Osint
;
32 package body Switch
.M
is
34 package Normalized_Switches
is new Table
.Table
35 (Table_Component_Type
=> String_Access
,
36 Table_Index_Type
=> Integer,
39 Table_Increment
=> 100,
40 Table_Name
=> "Switch.C.Normalized_Switches");
41 -- This table is used to keep the normalized switches, so that they may be
42 -- reused for subsequent invocations of Normalize_Compiler_Switches with
45 Initial_Number_Of_Switches
: constant := 10;
47 Global_Switches
: Argument_List_Access
:= null;
48 -- Used by function Normalize_Compiler_Switches
50 ---------------------------------
51 -- Normalize_Compiler_Switches --
52 ---------------------------------
54 procedure Normalize_Compiler_Switches
55 (Switch_Chars
: String;
56 Switches
: in out Argument_List_Access
;
59 Switch_Starts_With_Gnat
: Boolean;
61 Ptr
: Integer := Switch_Chars
'First;
62 Max
: constant Integer := Switch_Chars
'Last;
65 First_Char
: Integer := Ptr
;
66 Storing
: String := Switch_Chars
;
67 First_Stored
: Positive := Ptr
+ 1;
68 Last_Stored
: Positive := First_Stored
;
70 procedure Add_Switch_Component
(S
: String);
71 -- Add a new String_Access component in Switches. If a string equal
72 -- to S is already stored in the table Normalized_Switches, use it.
73 -- Other wise add a new component to the table.
75 --------------------------
76 -- Add_Switch_Component --
77 --------------------------
79 procedure Add_Switch_Component
(S
: String) is
81 -- If Switches is null, allocate a new array
83 if Switches
= null then
84 Switches
:= new Argument_List
(1 .. Initial_Number_Of_Switches
);
86 -- otherwise, if Switches is full, extend it
88 elsif Last
= Switches
'Last then
90 New_Switches
: Argument_List_Access
:= new Argument_List
91 (1 .. Switches
'Length + Switches
'Length);
93 New_Switches
(1 .. Switches
'Length) := Switches
.all;
94 Last
:= Switches
'Length;
95 Switches
:= New_Switches
;
99 -- If this is the first switch, Last designates the first component
101 Last
:= Switches
'First;
107 -- Look into the table Normalized_Switches for a similar string.
108 -- If one is found, put it at the added component, and return.
110 for Index
in 1 .. Normalized_Switches
.Last
loop
111 if S
= Normalized_Switches
.Table
(Index
).all then
112 Switches
(Last
) := Normalized_Switches
.Table
(Index
);
117 -- No string equal to S was found in the table Normalized_Switches.
118 -- Add a new component in the table.
120 Switches
(Last
) := new String'(S);
121 Normalized_Switches.Increment_Last;
122 Normalized_Switches.Table (Normalized_Switches.Last) :=
124 end Add_Switch_Component;
126 -- Start of processing for Normalize_Compiler_Switches
131 if Ptr = Max or else Switch_Chars (Ptr) /= '-' then
137 Switch_Starts_With_Gnat :=
138 Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
140 if Switch_Starts_With_Gnat then
145 while Ptr <= Max loop
147 C := Switch_Chars (Ptr);
149 -- Processing for a switch
151 case Switch_Starts_With_Gnat is
154 -- All switches that don't start with -gnat stay as is
156 Add_Switch_Component (Switch_Chars);
163 -- One-letter switches
165 when 'a
' | 'A
' | 'b
' | 'c
' | 'C
' | 'D
' | 'E
' | 'f
' |
166 'F
' | 'g
' | 'h
' | 'H
' | 'k
' | 'l
' | 'L
' | 'n
' | 'N
' |
167 'o
' | 'O
' | 'p
' | 'P
' | 'q
' | 'Q
' | 'r
' | 's
' | 't
' |
168 'u
' | 'U
' | 'v
' | 'x
' | 'X
' | 'Z
' =>
169 Storing (First_Stored) := C;
171 (Storing (Storing'First .. First_Stored));
174 -- One-letter switches followed by a positive number
177 Storing (First_Stored) := C;
178 Last_Stored := First_Stored;
183 or else Switch_Chars (Ptr) not in '0' .. '9';
184 Last_Stored := Last_Stored + 1;
185 Storing (Last_Stored) := Switch_Chars (Ptr);
189 (Storing (Storing'First .. Last_Stored));
192 Storing (First_Stored) := 'd
';
196 C := Switch_Chars (Ptr);
197 exit when C = ASCII.NUL or else C = '/'
200 if C in '1' .. '9' or else
201 C in 'a
' .. 'z
' or else
204 Storing (First_Stored + 1) := C;
206 (Storing (Storing'First .. First_Stored + 1));
217 -- None of the -gnate switches (-gnatec and -gnatem)
218 -- need to be store in an ALI file.
223 Storing (First_Stored) := 'i
';
232 C := Switch_Chars (Ptr);
241 Storing (First_Stored + 1) := C;
243 (Storing (Storing'First .. First_Stored + 1));
251 -- -gnatR may be followed by '0', '1', '2' or '3',
255 Last_Stored := First_Stored;
256 Storing (Last_Stored) := 'R
';
260 and then Switch_Chars (Ptr) in '0' .. '9'
262 C := Switch_Chars (Ptr);
264 if C in '4' .. '9' then
269 Last_Stored := Last_Stored + 1;
270 Storing (Last_Stored) := C;
274 and then Switch_Chars (Ptr) = 's
' then
275 Last_Stored := Last_Stored + 1;
276 Storing (Last_Stored) := 's
';
283 (Storing (Storing'First .. Last_Stored));
287 when 'V
' | 'w
' | 'y
' =>
288 Storing (First_Stored) := C;
294 (Storing (Storing'First .. First_Stored));
302 while Ptr <= Max loop
303 C := Switch_Chars (Ptr);
306 -- 'w
' should be skipped in -gnatw
308 if C /= 'w
' or else Storing (First_Stored) /= 'w
' then
313 and then Storing (First_Stored) = 'y
' then
314 Last_Stored := First_Stored + 1;
315 Storing (Last_Stored) := 'M
';
317 while Ptr <= Max loop
318 C := Switch_Chars (Ptr);
319 exit when C not in '0' .. '9';
320 Last_Stored := Last_Stored + 1;
321 Storing (Last_Stored) := C;
325 -- If there is no digit after -gnatyM,
326 -- the switch is invalid.
328 if Last_Stored = First_Stored + 1 then
334 (Storing (Storing'First .. Last_Stored));
337 -- All other switches are -gnatxx
340 Storing (First_Stored + 1) := C;
342 (Storing (Storing'First .. First_Stored + 1));
347 -- Not a valid switch
357 end Normalize_Compiler_Switches;
359 function Normalize_Compiler_Switches
360 (Switch_Chars : String)
366 Normalize_Compiler_Switches (Switch_Chars, Global_Switches, Last);
369 return (1 .. 0 => null);
372 return Global_Switches (Global_Switches'First .. Last);
375 end Normalize_Compiler_Switches;
377 ------------------------
378 -- Scan_Make_Switches --
379 ------------------------
381 procedure Scan_Make_Switches (Switch_Chars : String) is
382 Ptr : Integer := Switch_Chars'First;
383 Max : Integer := Switch_Chars'Last;
384 C : Character := ' ';
387 -- Skip past the initial character (must be the switch character)
396 -- A little check, "gnat" at the start of a switch is not allowed
397 -- except for the compiler (where it was already removed)
399 if Switch_Chars'Length >= Ptr + 3
400 and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
403 ("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
406 -- Loop to scan through switches given in switch string
408 while Ptr <= Max loop
409 C := Switch_Chars (Ptr);
411 -- Processing for a switch
417 Check_Readonly_Files := True;
419 -- Processing for b switch
425 -- Processing for c switch
429 Compile_Only := True;
431 -- Processing for C switch
435 Create_Mapping_File := True;
437 -- Processing for d switch
441 -- Note: for the debug switch, the remaining characters in this
442 -- switch field must all be debug flags, since all valid switch
443 -- characters are also valid debug characters. This switch is not
444 -- documented on purpose because it is only used by the
447 -- Loop to scan out debug flags
451 C := Switch_Chars (Ptr);
452 exit when C = ASCII.NUL or else C = '/' or else C = '-';
454 if C in '1' .. '9' or else
455 C in 'a
' .. 'z
' or else
464 -- Make sure Zero_Cost_Exceptions is set if gnatdX set. This
465 -- is for backwards compatibility with old versions and usage.
467 if Debug_Flag_XX then
468 Zero_Cost_Exceptions_Set := True;
469 Zero_Cost_Exceptions_Val := True;
474 -- Processing for f switch
478 Force_Compilations := True;
480 -- Processing for h switch
484 Usage_Requested := True;
486 -- Processing for i switch
490 In_Place_Mode := True;
492 -- Processing for j switch
500 Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc);
501 Maximum_Processes := Positive (Max_Proc);
504 -- Processing for k switch
510 -- Processing for l switch
518 List_Dependencies := True;
520 -- Processing for n switch
524 Do_Not_Execute := True;
526 -- Processing for o switch
531 if Output_File_Name_Present then
532 raise Too_Many_Output_Files;
534 Output_File_Name_Present := True;
537 -- Processing for q switch
541 Quiet_Output := True;
543 -- Processing for s switch
547 Check_Switches := True;
549 -- Processing for v switch
553 Verbose_Mode := True;
555 -- Processing for z switch
559 No_Main_Subprogram := True;
561 -- Ignore extra switch character
566 -- Anything else is an error (illegal switch character)
576 Osint.Fail ("invalid switch: ", (1 => C));
578 when Bad_Switch_Value =>
579 Osint.Fail ("numeric value too big for switch: ", (1 => C));
581 when Missing_Switch_Value =>
582 Osint.Fail ("missing numeric value for switch: ", (1 => C));
584 when Too_Many_Output_Files =>
585 Osint.Fail ("duplicate -o switch");
587 end Scan_Make_Switches;