* tree-vect-loop-manip.c (vect_do_peeling): Do not use
[official-gcc.git] / gcc / ada / switch-c.adb
blobc1ff88d234e5b5b15eab09e74f9a4bb7a52f0f1a
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S W I T C H - C --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2017, 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 ------------------------------------------------------------------------------
26 -- This package is for switch processing and should not depend on higher level
27 -- packages such as those for the scanner, parser, etc. Doing so may cause
28 -- circularities, especially for back ends using Adabkend.
30 with Debug; use Debug;
31 with Errout; use Errout;
32 with Lib; use Lib;
33 with Osint; use Osint;
34 with Opt; use Opt;
35 with Stylesw; use Stylesw;
36 with Targparm; use Targparm;
37 with Ttypes; use Ttypes;
38 with Validsw; use Validsw;
39 with Warnsw; use Warnsw;
41 with Ada.Unchecked_Deallocation;
43 with System.WCh_Con; use System.WCh_Con;
44 with System.OS_Lib;
46 package body Switch.C is
48 RTS_Specified : String_Access := null;
49 -- Used to detect multiple use of --RTS= flag
51 procedure Add_Symbol_Definition (Def : String);
52 -- Add a symbol definition from the command line
54 procedure Free is
55 new Ada.Unchecked_Deallocation (String_List, String_List_Access);
56 -- Avoid using System.Strings.Free, which also frees the designated strings
58 function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type;
59 -- Given a digit in the range 0 .. 3, returns the corresponding value of
60 -- Overflow_Mode_Type. Raises Program_Error if C is outside this range.
62 function Switch_Subsequently_Cancelled
63 (C : String;
64 Args : String_List;
65 Arg_Rank : Positive) return Boolean;
66 -- This function is called from Scan_Front_End_Switches. It determines if
67 -- the switch currently being scanned is followed by a switch of the form
68 -- "-gnat-" & C, where C is the argument. If so, then True is returned,
69 -- and Scan_Front_End_Switches will cancel the effect of the switch. If
70 -- no such switch is found, False is returned.
72 ---------------------------
73 -- Add_Symbol_Definition --
74 ---------------------------
76 procedure Add_Symbol_Definition (Def : String) is
77 begin
78 -- If Preprocessor_Symbol_Defs is not large enough, double its size
80 if Preprocessing_Symbol_Last = Preprocessing_Symbol_Defs'Last then
81 declare
82 New_Symbol_Definitions : constant String_List_Access :=
83 new String_List (1 .. 2 * Preprocessing_Symbol_Last);
84 begin
85 New_Symbol_Definitions (Preprocessing_Symbol_Defs'Range) :=
86 Preprocessing_Symbol_Defs.all;
87 Free (Preprocessing_Symbol_Defs);
88 Preprocessing_Symbol_Defs := New_Symbol_Definitions;
89 end;
90 end if;
92 Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1;
93 Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last) :=
94 new String'(Def);
95 end Add_Symbol_Definition;
97 -----------------------
98 -- Get_Overflow_Mode --
99 -----------------------
101 function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type is
102 begin
103 case C is
104 when '1' =>
105 return Strict;
107 when '2' =>
108 return Minimized;
110 -- Eliminated allowed only if Long_Long_Integer is 64 bits (since
111 -- the current implementation of System.Bignums assumes this).
113 when '3' =>
114 if Standard_Long_Long_Integer_Size /= 64 then
115 Bad_Switch ("-gnato3 not implemented for this configuration");
116 else
117 return Eliminated;
118 end if;
120 when others =>
121 raise Program_Error;
122 end case;
123 end Get_Overflow_Mode;
125 -----------------------------
126 -- Scan_Front_End_Switches --
127 -----------------------------
129 procedure Scan_Front_End_Switches
130 (Switch_Chars : String;
131 Args : String_List;
132 Arg_Rank : Positive)
134 First_Switch : Boolean := True;
135 -- False for all but first switch
137 Max : constant Natural := Switch_Chars'Last;
138 Ptr : Natural;
139 C : Character := ' ';
140 Dot : Boolean;
142 Store_Switch : Boolean;
143 -- For -gnatxx switches, the normal processing, signalled by this flag
144 -- being set to True, is to store the switch on exit from the case
145 -- statement, the switch stored is -gnat followed by the characters
146 -- from First_Char to Ptr-1. For cases like -gnaty, where the switch
147 -- is stored in separate pieces, this flag is set to False, and the
148 -- appropriate calls to Store_Compilation_Switch are made from within
149 -- the case branch.
151 First_Char : Positive;
152 -- Marks start of switch to be stored
154 First_Ptr : Positive;
155 -- Save position of first character after -gnatd (for checking that
156 -- debug flags that must come first are first, in particular -gnatd.b),
158 begin
159 Ptr := Switch_Chars'First;
161 -- Skip past the initial character (must be the switch character)
163 if Ptr = Max then
164 Bad_Switch (C);
165 else
166 Ptr := Ptr + 1;
167 end if;
169 -- Handle switches that do not start with -gnat
171 if Ptr + 3 > Max or else Switch_Chars (Ptr .. Ptr + 3) /= "gnat" then
173 -- There are two front-end switches that do not start with -gnat:
174 -- -I, --RTS
176 if Switch_Chars (Ptr) = 'I' then
178 -- Set flag Search_Directory_Present if switch is "-I" only:
179 -- the directory will be the next argument.
181 if Ptr = Max then
182 Search_Directory_Present := True;
183 return;
184 end if;
186 Ptr := Ptr + 1;
188 -- Find out whether this is a -I- or regular -Ixxx switch
190 -- Note: -I switches are not recorded in the ALI file, since the
191 -- meaning of the program depends on the source files compiled,
192 -- not where they came from.
194 if Ptr = Max and then Switch_Chars (Ptr) = '-' then
195 Look_In_Primary_Dir := False;
196 else
197 Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
198 end if;
200 -- Processing of the --RTS switch. --RTS may have been modified by
201 -- gcc into -fRTS (for GCC targets).
203 elsif Ptr + 3 <= Max
204 and then (Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
205 or else
206 Switch_Chars (Ptr .. Ptr + 3) = "-RTS")
207 then
208 Ptr := Ptr + 1;
210 if Ptr + 4 > Max
211 or else Switch_Chars (Ptr + 3) /= '='
212 then
213 Osint.Fail ("missing path for --RTS");
215 else
216 declare
217 Runtime_Dir : String_Access;
218 begin
219 if System.OS_Lib.Is_Absolute_Path
220 (Switch_Chars (Ptr + 4 .. Max))
221 then
222 Runtime_Dir :=
223 new String'(System.OS_Lib.Normalize_Pathname
224 (Switch_Chars (Ptr + 4 .. Max)));
225 else
226 Runtime_Dir :=
227 new String'(Switch_Chars (Ptr + 4 .. Max));
228 end if;
230 -- Valid --RTS switch
232 Opt.No_Stdinc := True;
233 Opt.RTS_Switch := True;
235 RTS_Src_Path_Name :=
236 Get_RTS_Search_Dir (Runtime_Dir.all, Include);
238 RTS_Lib_Path_Name :=
239 Get_RTS_Search_Dir (Runtime_Dir.all, Objects);
241 if RTS_Specified /= null then
242 if RTS_Src_Path_Name = null
243 or else RTS_Lib_Path_Name = null
244 or else
245 System.OS_Lib.Normalize_Pathname
246 (RTS_Specified.all) /=
247 System.OS_Lib.Normalize_Pathname
248 (RTS_Lib_Path_Name.all)
249 then
250 Osint.Fail
251 ("--RTS cannot be specified multiple times");
252 end if;
254 elsif RTS_Src_Path_Name /= null
255 and then RTS_Lib_Path_Name /= null
256 then
257 -- Store the -fRTS switch (Note: Store_Compilation_Switch
258 -- changes -fRTS back into --RTS for the actual output).
260 Store_Compilation_Switch (Switch_Chars);
261 RTS_Specified := new String'(RTS_Lib_Path_Name.all);
263 elsif RTS_Src_Path_Name = null
264 and then RTS_Lib_Path_Name = null
265 then
266 Osint.Fail ("RTS path not valid: missing "
267 & "adainclude and adalib directories");
269 elsif RTS_Src_Path_Name = null then
270 Osint.Fail ("RTS path not valid: missing "
271 & "adainclude directory");
273 elsif RTS_Lib_Path_Name = null then
274 Osint.Fail ("RTS path not valid: missing "
275 & "adalib directory");
276 end if;
277 end;
278 end if;
280 -- There are no other switches not starting with -gnat
282 else
283 Bad_Switch (Switch_Chars);
284 end if;
286 -- Case of switch starting with -gnat
288 else
289 Ptr := Ptr + 4;
291 -- Loop to scan through switches given in switch string
293 while Ptr <= Max loop
294 First_Char := Ptr;
295 Store_Switch := True;
297 C := Switch_Chars (Ptr);
299 case C is
301 -- -gnata (assertions enabled)
303 when 'a' =>
304 Ptr := Ptr + 1;
305 Assertions_Enabled := True;
307 -- -gnatA (disregard gnat.adc)
309 when 'A' =>
310 Ptr := Ptr + 1;
311 Config_File := False;
313 -- -gnatb (brief messages to stderr)
315 when 'b' =>
316 Ptr := Ptr + 1;
317 Brief_Output := True;
319 -- -gnatB (assume no invalid values)
321 when 'B' =>
322 Ptr := Ptr + 1;
323 Assume_No_Invalid_Values := True;
325 -- -gnatc (check syntax and semantics only)
327 when 'c' =>
328 if not First_Switch then
329 Osint.Fail
330 ("-gnatc must be first if combined with other switches");
331 end if;
333 Ptr := Ptr + 1;
334 Operating_Mode := Check_Semantics;
336 -- -gnatC (Generate CodePeer information)
338 when 'C' =>
339 Ptr := Ptr + 1;
340 CodePeer_Mode := True;
342 -- -gnatd (compiler debug options)
344 when 'd' =>
345 Store_Switch := False;
346 Dot := False;
347 First_Ptr := Ptr + 1;
349 -- Note: for the debug switch, the remaining characters in this
350 -- switch field must all be debug flags, since all valid switch
351 -- characters are also valid debug characters.
353 -- Loop to scan out debug flags
355 while Ptr < Max loop
356 Ptr := Ptr + 1;
357 C := Switch_Chars (Ptr);
358 exit when C = ASCII.NUL or else C = '/' or else C = '-';
360 if C in '1' .. '9' or else
361 C in 'a' .. 'z' or else
362 C in 'A' .. 'Z'
363 then
364 -- Case of dotted flag
366 if Dot then
367 Set_Dotted_Debug_Flag (C);
368 Store_Compilation_Switch ("-gnatd." & C);
370 -- Special check, -gnatd.b must come first
372 if C = 'b'
373 and then (Ptr /= First_Ptr + 1
374 or else not First_Switch)
375 then
376 Osint.Fail
377 ("-gnatd.b must be first if combined "
378 & "with other switches");
379 end if;
381 -- Not a dotted flag
383 else
384 Set_Debug_Flag (C);
385 Store_Compilation_Switch ("-gnatd" & C);
386 end if;
388 elsif C = '.' then
389 Dot := True;
391 elsif Dot then
392 Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max));
393 else
394 Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max));
395 end if;
396 end loop;
398 return;
400 -- -gnatD (debug expanded code)
402 when 'D' =>
403 Ptr := Ptr + 1;
405 -- Not allowed if previous -gnatR given
407 -- The reason for this prohibition is that the rewriting of
408 -- Sloc values causes strange malfunctions in the tests of
409 -- whether units belong to the main source. This is really a
410 -- bug, but too hard to fix for a marginal capability ???
412 -- The proper fix is to completely redo -gnatD processing so
413 -- that the tree is not messed with, and instead a separate
414 -- table is built on the side for debug information generation.
416 if List_Representation_Info /= 0 then
417 Osint.Fail
418 ("-gnatD not permitted since -gnatR given previously");
419 end if;
421 -- Scan optional integer line limit value
423 if Nat_Present (Switch_Chars, Max, Ptr) then
424 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'D');
425 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
426 end if;
428 -- Note: -gnatD also sets -gnatx (to turn off cross-reference
429 -- generation in the ali file) since otherwise this generation
430 -- gets confused by the "wrong" Sloc values put in the tree.
432 Debug_Generated_Code := True;
433 Xref_Active := False;
434 Set_Debug_Flag ('g');
436 -- -gnate? (extended switches)
438 when 'e' =>
439 Ptr := Ptr + 1;
441 -- The -gnate? switches are all double character switches
442 -- so we must always have a character after the e.
444 if Ptr > Max then
445 Bad_Switch ("-gnate");
446 end if;
448 case Switch_Chars (Ptr) is
450 -- -gnatea (initial delimiter of explicit switches)
452 -- This is an internal switch
454 -- All switches that come before -gnatea have been added by
455 -- the GCC driver and are not stored in the ALI file.
456 -- See also -gnatez below.
458 when 'a' =>
459 Store_Switch := False;
460 Enable_Switch_Storing;
461 Ptr := Ptr + 1;
463 -- -gnateA (aliasing checks on parameters)
465 when 'A' =>
466 Ptr := Ptr + 1;
467 Check_Aliasing_Of_Parameters := True;
469 -- -gnatec (configuration pragmas)
471 when 'c' =>
472 Store_Switch := False;
473 Ptr := Ptr + 1;
475 -- There may be an equal sign between -gnatec and
476 -- the path name of the config file.
478 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
479 Ptr := Ptr + 1;
480 end if;
482 if Ptr > Max then
483 Bad_Switch ("-gnatec");
484 end if;
486 declare
487 Config_File_Name : constant String_Access :=
488 new String'
489 (Switch_Chars (Ptr .. Max));
491 begin
492 if Config_File_Names = null then
493 Config_File_Names :=
494 new String_List'(1 => Config_File_Name);
496 else
497 declare
498 New_Names : constant String_List_Access :=
499 new String_List
500 (1 ..
501 Config_File_Names'Length + 1);
503 begin
504 for Index in Config_File_Names'Range loop
505 New_Names (Index) :=
506 Config_File_Names (Index);
507 Config_File_Names (Index) := null;
508 end loop;
510 New_Names (New_Names'Last) := Config_File_Name;
511 Free (Config_File_Names);
512 Config_File_Names := New_Names;
513 end;
514 end if;
515 end;
517 return;
519 -- -gnateC switch (generate CodePeer messages)
521 when 'C' =>
522 Ptr := Ptr + 1;
524 if not Generate_CodePeer_Messages then
525 Generate_CodePeer_Messages := True;
526 CodePeer_Mode := True;
527 Warning_Mode := Normal;
528 Warning_Doc_Switch := True; -- -gnatw.d
530 -- Enable warnings potentially useful for non GNAT
531 -- users.
533 Constant_Condition_Warnings := True; -- -gnatwc
534 Warn_On_Assertion_Failure := True; -- -gnatw.a
535 Warn_On_Assumed_Low_Bound := True; -- -gnatww
536 Warn_On_Bad_Fixed_Value := True; -- -gnatwb
537 Warn_On_Biased_Representation := True; -- -gnatw.b
538 Warn_On_Export_Import := True; -- -gnatwx
539 Warn_On_No_Value_Assigned := True; -- -gnatwv
540 Warn_On_Object_Renames_Function := True; -- -gnatw.r
541 Warn_On_Overlap := True; -- -gnatw.i
542 Warn_On_Parameter_Order := True; -- -gnatw.p
543 Warn_On_Questionable_Missing_Parens := True; -- -gnatwq
544 Warn_On_Redundant_Constructs := True; -- -gnatwr
545 Warn_On_Suspicious_Modulus_Value := True; -- -gnatw.m
546 end if;
548 -- -gnated switch (disable atomic synchronization)
550 when 'd' =>
551 Suppress_Options.Suppress (Atomic_Synchronization) :=
552 True;
554 -- -gnateD switch (preprocessing symbol definition)
556 when 'D' =>
557 Store_Switch := False;
558 Ptr := Ptr + 1;
560 if Ptr > Max then
561 Bad_Switch ("-gnateD");
562 end if;
564 Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
566 -- Store the switch
568 Store_Compilation_Switch
569 ("-gnateD" & Switch_Chars (Ptr .. Max));
570 Ptr := Max + 1;
572 -- -gnateE (extra exception information)
574 when 'E' =>
575 Exception_Extra_Info := True;
576 Ptr := Ptr + 1;
578 -- -gnatef (full source path for brief error messages)
580 when 'f' =>
581 Store_Switch := False;
582 Ptr := Ptr + 1;
583 Full_Path_Name_For_Brief_Errors := True;
585 -- -gnateF (Check_Float_Overflow)
587 when 'F' =>
588 Ptr := Ptr + 1;
589 Check_Float_Overflow := not Machine_Overflows_On_Target;
591 -- -gnateg (generate C code)
593 when 'g' =>
594 -- Special check, -gnateg must occur after -gnatc
596 if Operating_Mode /= Check_Semantics then
597 Osint.Fail
598 ("gnateg requires previous occurrence of -gnatc");
599 end if;
601 Generate_C_Code := True;
602 Ptr := Ptr + 1;
604 -- -gnateG (save preprocessor output)
606 when 'G' =>
607 Generate_Processed_File := True;
608 Ptr := Ptr + 1;
610 -- -gnatei (max number of instantiations)
612 when 'i' =>
613 Ptr := Ptr + 1;
614 Scan_Pos
615 (Switch_Chars, Max, Ptr, Maximum_Instantiations, C);
617 -- -gnateI (index of unit in multi-unit source)
619 when 'I' =>
620 Ptr := Ptr + 1;
621 Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
623 -- -gnatel
625 when 'l' =>
626 Ptr := Ptr + 1;
627 Elab_Info_Messages := True;
629 -- -gnateL
631 when 'L' =>
632 Ptr := Ptr + 1;
633 Elab_Info_Messages := False;
635 -- -gnatem (mapping file)
637 when 'm' =>
638 Store_Switch := False;
639 Ptr := Ptr + 1;
641 -- There may be an equal sign between -gnatem and
642 -- the path name of the mapping file.
644 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
645 Ptr := Ptr + 1;
646 end if;
648 if Ptr > Max then
649 Bad_Switch ("-gnatem");
650 end if;
652 Mapping_File_Name :=
653 new String'(Switch_Chars (Ptr .. Max));
654 return;
656 -- -gnateO= (object path file)
658 -- This is an internal switch
660 when 'O' =>
661 Store_Switch := False;
662 Ptr := Ptr + 1;
664 -- Check for '='
666 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
667 Bad_Switch ("-gnateO");
668 else
669 Object_Path_File_Name :=
670 new String'(Switch_Chars (Ptr + 1 .. Max));
671 end if;
673 return;
675 -- -gnatep (preprocessing data file)
677 when 'p' =>
678 Store_Switch := False;
679 Ptr := Ptr + 1;
681 -- There may be an equal sign between -gnatep and
682 -- the path name of the mapping file.
684 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
685 Ptr := Ptr + 1;
686 end if;
688 if Ptr > Max then
689 Bad_Switch ("-gnatep");
690 end if;
692 Preprocessing_Data_File :=
693 new String'(Switch_Chars (Ptr .. Max));
695 -- Store the switch, normalizing to -gnatep=
697 Store_Compilation_Switch
698 ("-gnatep=" & Preprocessing_Data_File.all);
700 Ptr := Max + 1;
702 -- -gnateP (Treat pragma Pure/Preelaborate errs as warnings)
704 when 'P' =>
705 Treat_Categorization_Errors_As_Warnings := True;
707 -- -gnates=file (specify extra file switches for gnat2why)
709 -- This is an internal switch
711 when 's' =>
712 if not First_Switch then
713 Osint.Fail
714 ("-gnates must not be combined with other switches");
715 end if;
717 -- Check for '='
719 Ptr := Ptr + 1;
721 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
722 Bad_Switch ("-gnates");
723 else
724 SPARK_Switches_File_Name :=
725 new String'(Switch_Chars (Ptr + 1 .. Max));
726 end if;
728 return;
730 -- -gnateS (generate SCO information)
732 -- Include Source Coverage Obligation information in ALI
733 -- files for use by source coverage analysis tools
734 -- (gnatcov) (equivalent to -fdump-scos, provided for
735 -- backwards compatibility).
737 when 'S' =>
738 Generate_SCO := True;
739 Generate_SCO_Instance_Table := True;
740 Ptr := Ptr + 1;
742 -- -gnatet (write target dependent information)
744 when 't' =>
745 if not First_Switch then
746 Osint.Fail
747 ("-gnatet must not be combined with other switches");
748 end if;
750 -- Check for '='
752 Ptr := Ptr + 1;
754 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
755 Bad_Switch ("-gnatet");
756 else
757 Target_Dependent_Info_Write_Name :=
758 new String'(Switch_Chars (Ptr + 1 .. Max));
759 end if;
761 return;
763 -- -gnateT (read target dependent information)
765 when 'T' =>
766 if not First_Switch then
767 Osint.Fail
768 ("-gnateT must not be combined with other switches");
769 end if;
771 -- Check for '='
773 Ptr := Ptr + 1;
775 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
776 Bad_Switch ("-gnateT");
777 else
778 -- This parameter was stored by Set_Targ earlier
780 pragma Assert
781 (Target_Dependent_Info_Read_Name.all =
782 Switch_Chars (Ptr + 1 .. Max));
783 null;
784 end if;
786 return;
788 -- -gnateu (unrecognized y,V,w switches)
790 when 'u' =>
791 Ptr := Ptr + 1;
792 Ignore_Unrecognized_VWY_Switches := True;
794 -- -gnateV (validity checks on parameters)
796 when 'V' =>
797 Ptr := Ptr + 1;
798 Check_Validity_Of_Parameters := True;
800 -- -gnateY (ignore Style_Checks pragmas)
802 when 'Y' =>
803 Ignore_Style_Checks_Pragmas := True;
804 Ptr := Ptr + 1;
806 -- -gnatez (final delimiter of explicit switches)
808 -- This is an internal switch
810 -- All switches that come after -gnatez have been added by
811 -- the GCC driver and are not stored in the ALI file. See
812 -- also -gnatea above.
814 when 'z' =>
815 Store_Switch := False;
816 Disable_Switch_Storing;
817 Ptr := Ptr + 1;
819 -- All other -gnate? switches are unassigned
821 when others =>
822 Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max));
823 end case;
825 -- -gnatE (dynamic elaboration checks)
827 when 'E' =>
828 Ptr := Ptr + 1;
829 Dynamic_Elaboration_Checks := True;
831 -- -gnatf (full error messages)
833 when 'f' =>
834 Ptr := Ptr + 1;
835 All_Errors_Mode := True;
837 -- -gnatF (overflow of predefined float types)
839 when 'F' =>
840 Ptr := Ptr + 1;
841 External_Name_Exp_Casing := Uppercase;
842 External_Name_Imp_Casing := Uppercase;
844 -- -gnatg (GNAT implementation mode)
846 when 'g' =>
847 Ptr := Ptr + 1;
848 GNAT_Mode := True;
849 GNAT_Mode_Config := True;
850 Identifier_Character_Set := 'n';
851 System_Extend_Unit := Empty;
852 Warning_Mode := Treat_As_Error;
853 Style_Check_Main := True;
854 Ada_Version := Ada_2012;
855 Ada_Version_Explicit := Ada_2012;
856 Ada_Version_Pragma := Empty;
858 -- Set default warnings and style checks for -gnatg
860 Set_GNAT_Mode_Warnings;
861 Set_GNAT_Style_Check_Options;
863 -- -gnatG (output generated code)
865 when 'G' =>
866 Ptr := Ptr + 1;
867 Print_Generated_Code := True;
869 -- Scan optional integer line limit value
871 if Nat_Present (Switch_Chars, Max, Ptr) then
872 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G');
873 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
874 end if;
876 -- -gnath (help information)
878 when 'h' =>
879 Ptr := Ptr + 1;
880 Usage_Requested := True;
882 -- -gnati (character set)
884 when 'i' =>
885 if Ptr = Max then
886 Bad_Switch ("-gnati");
887 end if;
889 Ptr := Ptr + 1;
890 C := Switch_Chars (Ptr);
892 if C in '1' .. '5'
893 or else C = '8'
894 or else C = '9'
895 or else C = 'p'
896 or else C = 'f'
897 or else C = 'n'
898 or else C = 'w'
899 then
900 Identifier_Character_Set := C;
901 Ptr := Ptr + 1;
903 else
904 Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max));
905 end if;
907 -- -gnatI (ignore representation clauses)
909 when 'I' =>
910 Ptr := Ptr + 1;
911 Ignore_Rep_Clauses := True;
913 -- -gnatj (messages in limited length lines)
915 when 'j' =>
916 Ptr := Ptr + 1;
917 Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
919 -- -gnatk (limit file name length)
921 when 'k' =>
922 Ptr := Ptr + 1;
923 Scan_Pos
924 (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
926 -- -gnatl (output full source)
928 when 'l' =>
929 Ptr := Ptr + 1;
930 Full_List := True;
932 -- There may be an equal sign between -gnatl and a file name
934 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
935 if Ptr = Max then
936 Osint.Fail ("file name for -gnatl= is null");
937 else
938 Opt.Full_List_File_Name :=
939 new String'(Switch_Chars (Ptr + 1 .. Max));
940 Ptr := Max + 1;
941 end if;
942 end if;
944 -- -gnatL (corresponding source text)
946 when 'L' =>
947 Ptr := Ptr + 1;
948 Dump_Source_Text := True;
950 -- -gnatm (max number or errors/warnings)
952 when 'm' =>
953 Ptr := Ptr + 1;
954 Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C);
956 -- -gnatn (enable pragma Inline)
958 when 'n' =>
959 Ptr := Ptr + 1;
960 Inline_Active := True;
962 -- There may be a digit (1 or 2) appended to the switch
964 if Ptr <= Max then
965 C := Switch_Chars (Ptr);
967 if C in '1' .. '2' then
968 Ptr := Ptr + 1;
969 Inline_Level := Character'Pos (C) - Character'Pos ('0');
970 end if;
971 end if;
973 -- -gnatN (obsolescent)
975 when 'N' =>
976 Ptr := Ptr + 1;
977 Inline_Active := True;
978 Front_End_Inlining := True;
980 -- -gnato (overflow checks)
982 when 'o' =>
983 Ptr := Ptr + 1;
985 -- Case of -gnato0 (overflow checking turned off)
987 if Ptr <= Max and then Switch_Chars (Ptr) = '0' then
988 Ptr := Ptr + 1;
989 Suppress_Options.Suppress (Overflow_Check) := True;
991 -- We set strict mode in case overflow checking is turned
992 -- on locally (also records that we had a -gnato switch).
994 Suppress_Options.Overflow_Mode_General := Strict;
995 Suppress_Options.Overflow_Mode_Assertions := Strict;
997 -- All cases other than -gnato0 (overflow checking turned on)
999 else
1000 Suppress_Options.Suppress (Overflow_Check) := False;
1002 -- Case of no digits after the -gnato
1004 if Ptr > Max
1005 or else Switch_Chars (Ptr) not in '1' .. '3'
1006 then
1007 Suppress_Options.Overflow_Mode_General := Strict;
1008 Suppress_Options.Overflow_Mode_Assertions := Strict;
1010 -- At least one digit after the -gnato
1012 else
1013 -- Handle first digit after -gnato
1015 Suppress_Options.Overflow_Mode_General :=
1016 Get_Overflow_Mode (Switch_Chars (Ptr));
1017 Ptr := Ptr + 1;
1019 -- Only one digit after -gnato, set assertions mode to be
1020 -- the same as general mode.
1022 if Ptr > Max
1023 or else Switch_Chars (Ptr) not in '1' .. '3'
1024 then
1025 Suppress_Options.Overflow_Mode_Assertions :=
1026 Suppress_Options.Overflow_Mode_General;
1028 -- Process second digit after -gnato
1030 else
1031 Suppress_Options.Overflow_Mode_Assertions :=
1032 Get_Overflow_Mode (Switch_Chars (Ptr));
1033 Ptr := Ptr + 1;
1034 end if;
1035 end if;
1036 end if;
1038 -- -gnatO (specify name of the object file)
1040 -- This is an internal switch
1042 when 'O' =>
1043 Store_Switch := False;
1044 Ptr := Ptr + 1;
1045 Output_File_Name_Present := True;
1047 -- -gnatp (suppress all checks)
1049 when 'p' =>
1050 Ptr := Ptr + 1;
1052 -- Skip processing if cancelled by subsequent -gnat-p
1054 if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then
1055 Store_Switch := False;
1057 else
1058 -- Set all specific options as well as All_Checks in the
1059 -- Suppress_Options array, excluding Elaboration_Check,
1060 -- since this is treated specially because we do not want
1061 -- -gnatp to disable static elaboration processing. Also
1062 -- exclude Atomic_Synchronization, since this is not a real
1063 -- check.
1065 for J in Suppress_Options.Suppress'Range loop
1066 if J /= Elaboration_Check
1067 and then
1068 J /= Atomic_Synchronization
1069 then
1070 Suppress_Options.Suppress (J) := True;
1071 end if;
1072 end loop;
1074 Validity_Checks_On := False;
1075 Opt.Suppress_Checks := True;
1077 -- Set overflow mode checking to strict in case it gets
1078 -- turned on locally (also signals that overflow checking
1079 -- has been specifically turned off).
1081 Suppress_Options.Overflow_Mode_General := Strict;
1082 Suppress_Options.Overflow_Mode_Assertions := Strict;
1083 end if;
1085 -- -gnatP (periodic poll)
1087 when 'P' =>
1088 Ptr := Ptr + 1;
1089 Polling_Required := True;
1091 -- -gnatq (don't quit)
1093 when 'q' =>
1094 Ptr := Ptr + 1;
1095 Try_Semantics := True;
1097 -- -gnatQ (always write ALI file)
1099 when 'Q' =>
1100 Ptr := Ptr + 1;
1101 Force_ALI_Tree_File := True;
1102 Try_Semantics := True;
1104 -- -gnatr (restrictions as warnings)
1106 when 'r' =>
1107 Ptr := Ptr + 1;
1108 Treat_Restrictions_As_Warnings := True;
1110 -- -gnatR (list rep. info)
1112 when 'R' =>
1114 -- Not allowed if previous -gnatD given. See more extensive
1115 -- comments in the 'D' section for the inverse test.
1117 if Debug_Generated_Code then
1118 Osint.Fail
1119 ("-gnatR not permitted since -gnatD given previously");
1120 end if;
1122 -- Set to annotate rep info, and set default -gnatR mode
1124 Back_Annotate_Rep_Info := True;
1125 List_Representation_Info := 1;
1127 -- Scan possible parameter
1129 Ptr := Ptr + 1;
1130 while Ptr <= Max loop
1131 C := Switch_Chars (Ptr);
1133 case C is
1135 when '0' .. '3' =>
1136 List_Representation_Info :=
1137 Character'Pos (C) - Character'Pos ('0');
1139 when 's' =>
1140 List_Representation_Info_To_File := True;
1142 when 'm' =>
1143 List_Representation_Info_Mechanisms := True;
1145 when 'e' =>
1146 List_Representation_Info_Extended := True;
1148 when others =>
1149 Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
1150 end case;
1152 Ptr := Ptr + 1;
1153 end loop;
1155 -- -gnats (syntax check only)
1157 when 's' =>
1158 if not First_Switch then
1159 Osint.Fail
1160 ("-gnats must be first if combined with other switches");
1161 end if;
1163 Ptr := Ptr + 1;
1164 Operating_Mode := Check_Syntax;
1166 -- -gnatS (print package Standard)
1168 when 'S' =>
1169 Print_Standard := True;
1170 Ptr := Ptr + 1;
1172 -- -gnatt (output tree)
1174 when 't' =>
1175 Ptr := Ptr + 1;
1176 Tree_Output := True;
1177 Back_Annotate_Rep_Info := True;
1179 -- -gnatT (change start of internal table sizes)
1181 when 'T' =>
1182 Ptr := Ptr + 1;
1183 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
1185 -- -gnatu (list units for compilation)
1187 when 'u' =>
1188 Ptr := Ptr + 1;
1189 List_Units := True;
1191 -- -gnatU (unique tags)
1193 when 'U' =>
1194 Ptr := Ptr + 1;
1195 Unique_Error_Tag := True;
1197 -- -gnatv (verbose mode)
1199 when 'v' =>
1200 Ptr := Ptr + 1;
1201 Verbose_Mode := True;
1203 -- -gnatV (validity checks)
1205 when 'V' =>
1206 Store_Switch := False;
1207 Ptr := Ptr + 1;
1209 if Ptr > Max then
1210 Bad_Switch ("-gnatV");
1212 else
1213 declare
1214 OK : Boolean;
1216 begin
1217 Set_Validity_Check_Options
1218 (Switch_Chars (Ptr .. Max), OK, Ptr);
1220 if not OK then
1221 Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max));
1222 end if;
1224 for Index in First_Char + 1 .. Max loop
1225 Store_Compilation_Switch
1226 ("-gnatV" & Switch_Chars (Index));
1227 end loop;
1228 end;
1229 end if;
1231 Ptr := Max + 1;
1233 -- -gnatw (warning modes)
1235 when 'w' =>
1236 Store_Switch := False;
1237 Ptr := Ptr + 1;
1239 if Ptr > Max then
1240 Bad_Switch ("-gnatw");
1241 end if;
1243 while Ptr <= Max loop
1244 C := Switch_Chars (Ptr);
1246 -- Case of dot switch
1248 if C = '.' and then Ptr < Max then
1249 Ptr := Ptr + 1;
1250 C := Switch_Chars (Ptr);
1252 if Set_Dot_Warning_Switch (C) then
1253 Store_Compilation_Switch ("-gnatw." & C);
1254 else
1255 Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max));
1256 end if;
1258 -- Case of underscore switch
1260 elsif C = '_' and then Ptr < Max then
1261 Ptr := Ptr + 1;
1262 C := Switch_Chars (Ptr);
1264 if Set_Underscore_Warning_Switch (C) then
1265 Store_Compilation_Switch ("-gnatw_" & C);
1266 else
1267 Bad_Switch ("-gnatw_" & Switch_Chars (Ptr .. Max));
1268 end if;
1270 -- Normal case, no dot
1272 else
1273 if Set_Warning_Switch (C) then
1274 Store_Compilation_Switch ("-gnatw" & C);
1275 else
1276 Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max));
1277 end if;
1278 end if;
1280 Ptr := Ptr + 1;
1281 end loop;
1283 return;
1285 -- -gnatW (wide character encoding method)
1287 when 'W' =>
1288 Ptr := Ptr + 1;
1290 if Ptr > Max then
1291 Bad_Switch ("-gnatW");
1292 end if;
1294 begin
1295 Wide_Character_Encoding_Method :=
1296 Get_WC_Encoding_Method (Switch_Chars (Ptr));
1297 exception
1298 when Constraint_Error =>
1299 Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max));
1300 end;
1302 Wide_Character_Encoding_Method_Specified := True;
1304 Upper_Half_Encoding :=
1305 Wide_Character_Encoding_Method in
1306 WC_Upper_Half_Encoding_Method;
1308 Ptr := Ptr + 1;
1310 -- -gnatx (suppress cross-ref information)
1312 when 'x' =>
1313 Ptr := Ptr + 1;
1314 Xref_Active := False;
1316 -- -gnatX (language extensions)
1318 when 'X' =>
1319 Ptr := Ptr + 1;
1320 Extensions_Allowed := True;
1321 Ada_Version := Ada_Version_Type'Last;
1322 Ada_Version_Explicit := Ada_Version_Type'Last;
1323 Ada_Version_Pragma := Empty;
1325 -- -gnaty (style checks)
1327 when 'y' =>
1328 Ptr := Ptr + 1;
1329 Style_Check_Main := True;
1331 if Ptr > Max then
1332 Set_Default_Style_Check_Options;
1334 else
1335 Store_Switch := False;
1337 declare
1338 OK : Boolean;
1340 begin
1341 Set_Style_Check_Options
1342 (Switch_Chars (Ptr .. Max), OK, Ptr);
1344 if not OK then
1345 Osint.Fail
1346 ("bad -gnaty switch (" &
1347 Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
1348 end if;
1350 Ptr := First_Char + 1;
1351 while Ptr <= Max loop
1352 if Switch_Chars (Ptr) = 'M' then
1353 First_Char := Ptr;
1354 loop
1355 Ptr := Ptr + 1;
1356 exit when Ptr > Max
1357 or else Switch_Chars (Ptr) not in '0' .. '9';
1358 end loop;
1360 Store_Compilation_Switch
1361 ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1));
1363 else
1364 Store_Compilation_Switch
1365 ("-gnaty" & Switch_Chars (Ptr));
1366 Ptr := Ptr + 1;
1367 end if;
1368 end loop;
1369 end;
1370 end if;
1372 -- -gnatz (stub generation)
1374 when 'z' =>
1376 -- -gnatz must be the first and only switch in Switch_Chars,
1377 -- and is a two-letter switch.
1379 if Ptr /= Switch_Chars'First + 5
1380 or else (Max - Ptr + 1) > 2
1381 then
1382 Osint.Fail
1383 ("-gnatz* may not be combined with other switches");
1384 end if;
1386 if Ptr = Max then
1387 Bad_Switch ("-gnatz");
1388 end if;
1390 Ptr := Ptr + 1;
1392 -- Only one occurrence of -gnat* is permitted
1394 if Distribution_Stub_Mode = No_Stubs then
1395 case Switch_Chars (Ptr) is
1396 when 'r' =>
1397 Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
1399 when 'c' =>
1400 Distribution_Stub_Mode := Generate_Caller_Stub_Body;
1402 when others =>
1403 Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
1404 end case;
1406 Ptr := Ptr + 1;
1408 else
1409 Osint.Fail ("only one -gnatz* switch allowed");
1410 end if;
1412 -- -gnatZ (obsolescent)
1414 when 'Z' =>
1415 Ptr := Ptr + 1;
1416 Osint.Fail
1417 ("-gnatZ is no longer supported: consider using --RTS=zcx");
1419 -- Note on language version switches: whenever a new language
1420 -- version switch is added, Switch.M.Normalize_Compiler_Switches
1421 -- must be updated.
1423 -- -gnat83
1425 when '8' =>
1426 if Ptr = Max then
1427 Bad_Switch ("-gnat8");
1428 end if;
1430 Ptr := Ptr + 1;
1432 if Switch_Chars (Ptr) /= '3' or else Latest_Ada_Only then
1433 Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
1434 else
1435 Ptr := Ptr + 1;
1436 Ada_Version := Ada_83;
1437 Ada_Version_Explicit := Ada_83;
1438 Ada_Version_Pragma := Empty;
1439 end if;
1441 -- -gnat95
1443 when '9' =>
1444 if Ptr = Max then
1445 Bad_Switch ("-gnat9");
1446 end if;
1448 Ptr := Ptr + 1;
1450 if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
1451 Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
1452 else
1453 Ptr := Ptr + 1;
1454 Ada_Version := Ada_95;
1455 Ada_Version_Explicit := Ada_95;
1456 Ada_Version_Pragma := Empty;
1457 end if;
1459 -- -gnat05
1461 when '0' =>
1462 if Ptr = Max then
1463 Bad_Switch ("-gnat0");
1464 end if;
1466 Ptr := Ptr + 1;
1468 if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
1469 Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
1470 else
1471 Ptr := Ptr + 1;
1472 Ada_Version := Ada_2005;
1473 Ada_Version_Explicit := Ada_2005;
1474 Ada_Version_Pragma := Empty;
1475 end if;
1477 -- -gnat12
1479 when '1' =>
1480 if Ptr = Max then
1481 Bad_Switch ("-gnat1");
1482 end if;
1484 Ptr := Ptr + 1;
1486 if Switch_Chars (Ptr) /= '2' then
1487 Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
1488 else
1489 Ptr := Ptr + 1;
1490 Ada_Version := Ada_2012;
1491 Ada_Version_Explicit := Ada_2012;
1492 Ada_Version_Pragma := Empty;
1493 end if;
1495 -- -gnat2005 and -gnat2012
1497 when '2' =>
1498 if Ptr > Max - 3 then
1499 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1501 elsif Switch_Chars (Ptr .. Ptr + 3) = "2005"
1502 and then not Latest_Ada_Only
1503 then
1504 Ada_Version := Ada_2005;
1506 elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
1507 Ada_Version := Ada_2012;
1509 elsif Switch_Chars (Ptr .. Ptr + 3) = "2020" then
1510 Ada_Version := Ada_2020;
1512 else
1513 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
1514 end if;
1516 Ada_Version_Explicit := Ada_Version;
1517 Ada_Version_Pragma := Empty;
1518 Ptr := Ptr + 4;
1520 -- Switch cancellation, currently only -gnat-p is allowed.
1521 -- All we do here is the error checking, since the actual
1522 -- processing for switch cancellation is done by calls to
1523 -- Switch_Subsequently_Cancelled at the appropriate point.
1525 when '-' =>
1527 -- Simple ignore -gnat-p
1529 if Switch_Chars = "-gnat-p" then
1530 return;
1532 -- Any other occurrence of minus is ignored. This is for
1533 -- maximum compatibility with previous version which ignored
1534 -- all occurrences of minus.
1536 else
1537 Store_Switch := False;
1538 Ptr := Ptr + 1;
1539 end if;
1541 -- We ignore '/' in switches, this is historical, still needed???
1543 when '/' =>
1544 Store_Switch := False;
1546 -- Anything else is an error (illegal switch character)
1548 when others =>
1549 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1550 end case;
1552 if Store_Switch then
1553 Store_Compilation_Switch
1554 ("-gnat" & Switch_Chars (First_Char .. Ptr - 1));
1555 end if;
1557 First_Switch := False;
1558 end loop;
1559 end if;
1560 end Scan_Front_End_Switches;
1562 -----------------------------------
1563 -- Switch_Subsequently_Cancelled --
1564 -----------------------------------
1566 function Switch_Subsequently_Cancelled
1567 (C : String;
1568 Args : String_List;
1569 Arg_Rank : Positive) return Boolean
1571 begin
1572 -- Loop through arguments following the current one
1574 for Arg in Arg_Rank + 1 .. Args'Last loop
1575 if Args (Arg).all = "-gnat-" & C then
1576 return True;
1577 end if;
1578 end loop;
1580 -- No match found, not cancelled
1582 return False;
1583 end Switch_Subsequently_Cancelled;
1585 end Switch.C;