File : switch-c.adb
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-2016, 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 -- 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.
29
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;
40
41 with Ada.Unchecked_Deallocation;
42
43 with System.WCh_Con; use System.WCh_Con;
44 with System.OS_Lib;
45
46 package body Switch.C is
47
48 RTS_Specified : String_Access := null;
49 -- Used to detect multiple use of --RTS= flag
50
51 procedure Add_Symbol_Definition (Def : String);
52 -- Add a symbol definition from the command line
53
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
57
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.
61
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.
71
72 ---------------------------
73 -- Add_Symbol_Definition --
74 ---------------------------
75
76 procedure Add_Symbol_Definition (Def : String) is
77 begin
78 -- If Preprocessor_Symbol_Defs is not large enough, double its size
79
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;
91
92 Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1;
93 Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last) :=
94 new String'(Def);
95 end Add_Symbol_Definition;
96
97 -----------------------
98 -- Get_Overflow_Mode --
99 -----------------------
100
101 function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type is
102 begin
103 case C is
104 when '1' =>
105 return Strict;
106
107 when '2' =>
108 return Minimized;
109
110 -- Eliminated allowed only if Long_Long_Integer is 64 bits (since
111 -- the current implementation of System.Bignums assumes this).
112
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;
119
120 when others =>
121 raise Program_Error;
122 end case;
123 end Get_Overflow_Mode;
124
125 -----------------------------
126 -- Scan_Front_End_Switches --
127 -----------------------------
128
129 procedure Scan_Front_End_Switches
130 (Switch_Chars : String;
131 Args : String_List;
132 Arg_Rank : Positive)
133 is
134 First_Switch : Boolean := True;
135 -- False for all but first switch
136
137 Max : constant Natural := Switch_Chars'Last;
138 Ptr : Natural;
139 C : Character := ' ';
140 Dot : Boolean;
141
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.
150
151 First_Char : Positive;
152 -- Marks start of switch to be stored
153
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),
157
158 begin
159 Ptr := Switch_Chars'First;
160
161 -- Skip past the initial character (must be the switch character)
162
163 if Ptr = Max then
164 Bad_Switch (C);
165 else
166 Ptr := Ptr + 1;
167 end if;
168
169 -- Handle switches that do not start with -gnat
170
171 if Ptr + 3 > Max or else Switch_Chars (Ptr .. Ptr + 3) /= "gnat" then
172
173 -- There are two front-end switches that do not start with -gnat:
174 -- -I, --RTS
175
176 if Switch_Chars (Ptr) = 'I' then
177
178 -- Set flag Search_Directory_Present if switch is "-I" only:
179 -- the directory will be the next argument.
180
181 if Ptr = Max then
182 Search_Directory_Present := True;
183 return;
184 end if;
185
186 Ptr := Ptr + 1;
187
188 -- Find out whether this is a -I- or regular -Ixxx switch
189
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.
193
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;
199
200 -- Processing of the --RTS switch. --RTS may have been modified by
201 -- gcc into -fRTS (for GCC targets).
202
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;
209
210 if Ptr + 4 > Max
211 or else Switch_Chars (Ptr + 3) /= '='
212 then
213 Osint.Fail ("missing path for --RTS");
214
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;
229
230 -- Valid --RTS switch
231
232 Opt.No_Stdinc := True;
233 Opt.RTS_Switch := True;
234
235 RTS_Src_Path_Name :=
236 Get_RTS_Search_Dir (Runtime_Dir.all, Include);
237
238 RTS_Lib_Path_Name :=
239 Get_RTS_Search_Dir (Runtime_Dir.all, Objects);
240
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;
253
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).
259
260 Store_Compilation_Switch (Switch_Chars);
261 RTS_Specified := new String'(RTS_Lib_Path_Name.all);
262
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");
268
269 elsif RTS_Src_Path_Name = null then
270 Osint.Fail ("RTS path not valid: missing "
271 & "adainclude directory");
272
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;
279
280 -- There are no other switches not starting with -gnat
281
282 else
283 Bad_Switch (Switch_Chars);
284 end if;
285
286 -- Case of switch starting with -gnat
287
288 else
289 Ptr := Ptr + 4;
290
291 -- Loop to scan through switches given in switch string
292
293 while Ptr <= Max loop
294 First_Char := Ptr;
295 Store_Switch := True;
296
297 C := Switch_Chars (Ptr);
298
299 case C is
300
301 -- -gnata (assertions enabled)
302
303 when 'a' =>
304 Ptr := Ptr + 1;
305 Assertions_Enabled := True;
306
307 -- -gnatA (disregard gnat.adc)
308
309 when 'A' =>
310 Ptr := Ptr + 1;
311 Config_File := False;
312
313 -- -gnatb (brief messages to stderr)
314
315 when 'b' =>
316 Ptr := Ptr + 1;
317 Brief_Output := True;
318
319 -- -gnatB (assume no invalid values)
320
321 when 'B' =>
322 Ptr := Ptr + 1;
323 Assume_No_Invalid_Values := True;
324
325 -- -gnatc (check syntax and semantics only)
326
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;
332
333 Ptr := Ptr + 1;
334 Operating_Mode := Check_Semantics;
335
336 -- -gnatC (Generate CodePeer information)
337
338 when 'C' =>
339 Ptr := Ptr + 1;
340
341 if not CodePeer_Mode then
342 CodePeer_Mode := True;
343
344 -- Suppress compiler warnings by default, since what we are
345 -- interested in here is what CodePeer can find out. Note
346 -- that if -gnatwxxx is specified after -gnatC on the
347 -- command line, we do not want to override this setting in
348 -- Adjust_Global_Switches, and assume that the user wants to
349 -- get both warnings from GNAT and CodePeer messages.
350
351 Warning_Mode := Suppress;
352 end if;
353
354 -- -gnatd (compiler debug options)
355
356 when 'd' =>
357 Store_Switch := False;
358 Dot := False;
359 First_Ptr := Ptr + 1;
360
361 -- Note: for the debug switch, the remaining characters in this
362 -- switch field must all be debug flags, since all valid switch
363 -- characters are also valid debug characters.
364
365 -- Loop to scan out debug flags
366
367 while Ptr < Max loop
368 Ptr := Ptr + 1;
369 C := Switch_Chars (Ptr);
370 exit when C = ASCII.NUL or else C = '/' or else C = '-';
371
372 if C in '1' .. '9' or else
373 C in 'a' .. 'z' or else
374 C in 'A' .. 'Z'
375 then
376 -- Case of dotted flag
377
378 if Dot then
379 Set_Dotted_Debug_Flag (C);
380 Store_Compilation_Switch ("-gnatd." & C);
381
382 -- Special check, -gnatd.b must come first
383
384 if C = 'b'
385 and then (Ptr /= First_Ptr + 1
386 or else not First_Switch)
387 then
388 Osint.Fail
389 ("-gnatd.b must be first if combined "
390 & "with other switches");
391 end if;
392
393 -- Not a dotted flag
394
395 else
396 Set_Debug_Flag (C);
397 Store_Compilation_Switch ("-gnatd" & C);
398 end if;
399
400 elsif C = '.' then
401 Dot := True;
402
403 elsif Dot then
404 Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max));
405 else
406 Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max));
407 end if;
408 end loop;
409
410 return;
411
412 -- -gnatD (debug expanded code)
413
414 when 'D' =>
415 Ptr := Ptr + 1;
416
417 -- Not allowed if previous -gnatR given
418
419 -- The reason for this prohibition is that the rewriting of
420 -- Sloc values causes strange malfunctions in the tests of
421 -- whether units belong to the main source. This is really a
422 -- bug, but too hard to fix for a marginal capability ???
423
424 -- The proper fix is to completely redo -gnatD processing so
425 -- that the tree is not messed with, and instead a separate
426 -- table is built on the side for debug information generation.
427
428 if List_Representation_Info /= 0 then
429 Osint.Fail
430 ("-gnatD not permitted since -gnatR given previously");
431 end if;
432
433 -- Scan optional integer line limit value
434
435 if Nat_Present (Switch_Chars, Max, Ptr) then
436 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'D');
437 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
438 end if;
439
440 -- Note: -gnatD also sets -gnatx (to turn off cross-reference
441 -- generation in the ali file) since otherwise this generation
442 -- gets confused by the "wrong" Sloc values put in the tree.
443
444 Debug_Generated_Code := True;
445 Xref_Active := False;
446 Set_Debug_Flag ('g');
447
448 -- -gnate? (extended switches)
449
450 when 'e' =>
451 Ptr := Ptr + 1;
452
453 -- The -gnate? switches are all double character switches
454 -- so we must always have a character after the e.
455
456 if Ptr > Max then
457 Bad_Switch ("-gnate");
458 end if;
459
460 case Switch_Chars (Ptr) is
461
462 -- -gnatea (initial delimiter of explicit switches)
463
464 -- This is an internal switch
465
466 -- All switches that come before -gnatea have been added by
467 -- the GCC driver and are not stored in the ALI file.
468 -- See also -gnatez below.
469
470 when 'a' =>
471 Store_Switch := False;
472 Enable_Switch_Storing;
473 Ptr := Ptr + 1;
474
475 -- -gnateA (aliasing checks on parameters)
476
477 when 'A' =>
478 Ptr := Ptr + 1;
479 Check_Aliasing_Of_Parameters := True;
480
481 -- -gnatec (configuration pragmas)
482
483 when 'c' =>
484 Store_Switch := False;
485 Ptr := Ptr + 1;
486
487 -- There may be an equal sign between -gnatec and
488 -- the path name of the config file.
489
490 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
491 Ptr := Ptr + 1;
492 end if;
493
494 if Ptr > Max then
495 Bad_Switch ("-gnatec");
496 end if;
497
498 declare
499 Config_File_Name : constant String_Access :=
500 new String'
501 (Switch_Chars (Ptr .. Max));
502
503 begin
504 if Config_File_Names = null then
505 Config_File_Names :=
506 new String_List'(1 => Config_File_Name);
507
508 else
509 declare
510 New_Names : constant String_List_Access :=
511 new String_List
512 (1 ..
513 Config_File_Names'Length + 1);
514
515 begin
516 for Index in Config_File_Names'Range loop
517 New_Names (Index) :=
518 Config_File_Names (Index);
519 Config_File_Names (Index) := null;
520 end loop;
521
522 New_Names (New_Names'Last) := Config_File_Name;
523 Free (Config_File_Names);
524 Config_File_Names := New_Names;
525 end;
526 end if;
527 end;
528
529 return;
530
531 -- -gnateC switch (generate CodePeer messages)
532
533 when 'C' =>
534 Ptr := Ptr + 1;
535
536 if not Generate_CodePeer_Messages then
537 Generate_CodePeer_Messages := True;
538 CodePeer_Mode := True;
539 Warning_Mode := Normal;
540 Warning_Doc_Switch := True; -- -gnatw.d
541
542 -- Enable warnings potentially useful for non GNAT
543 -- users.
544
545 Constant_Condition_Warnings := True; -- -gnatwc
546 Warn_On_Assertion_Failure := True; -- -gnatw.a
547 Warn_On_Assumed_Low_Bound := True; -- -gnatww
548 Warn_On_Bad_Fixed_Value := True; -- -gnatwb
549 Warn_On_Biased_Representation := True; -- -gnatw.b
550 Warn_On_Export_Import := True; -- -gnatwx
551 Warn_On_Modified_Unread := True; -- -gnatwm
552 Warn_On_No_Value_Assigned := True; -- -gnatwv
553 Warn_On_Object_Renames_Function := True; -- -gnatw.r
554 Warn_On_Overlap := True; -- -gnatw.i
555 Warn_On_Parameter_Order := True; -- -gnatw.p
556 Warn_On_Questionable_Missing_Parens := True; -- -gnatwq
557 Warn_On_Redundant_Constructs := True; -- -gnatwr
558 Warn_On_Suspicious_Modulus_Value := True; -- -gnatw.m
559 end if;
560
561 -- -gnated switch (disable atomic synchronization)
562
563 when 'd' =>
564 Suppress_Options.Suppress (Atomic_Synchronization) :=
565 True;
566
567 -- -gnateD switch (preprocessing symbol definition)
568
569 when 'D' =>
570 Store_Switch := False;
571 Ptr := Ptr + 1;
572
573 if Ptr > Max then
574 Bad_Switch ("-gnateD");
575 end if;
576
577 Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
578
579 -- Store the switch
580
581 Store_Compilation_Switch
582 ("-gnateD" & Switch_Chars (Ptr .. Max));
583 Ptr := Max + 1;
584
585 -- -gnateE (extra exception information)
586
587 when 'E' =>
588 Exception_Extra_Info := True;
589 Ptr := Ptr + 1;
590
591 -- -gnatef (full source path for brief error messages)
592
593 when 'f' =>
594 Store_Switch := False;
595 Ptr := Ptr + 1;
596 Full_Path_Name_For_Brief_Errors := True;
597
598 -- -gnateF (Check_Float_Overflow)
599
600 when 'F' =>
601 Ptr := Ptr + 1;
602 Check_Float_Overflow := not Machine_Overflows_On_Target;
603
604 -- -gnateg (generate C code)
605
606 when 'g' =>
607 -- Special check, -gnateg must occur after -gnatc
608
609 if Operating_Mode /= Check_Semantics then
610 Osint.Fail
611 ("gnateg requires previous occurrence of -gnatc");
612 end if;
613
614 Generate_C_Code := True;
615 Ptr := Ptr + 1;
616
617 -- -gnateG (save preprocessor output)
618
619 when 'G' =>
620 Generate_Processed_File := True;
621 Ptr := Ptr + 1;
622
623 -- -gnatei (max number of instantiations)
624
625 when 'i' =>
626 Ptr := Ptr + 1;
627 Scan_Pos
628 (Switch_Chars, Max, Ptr, Maximum_Instantiations, C);
629
630 -- -gnateI (index of unit in multi-unit source)
631
632 when 'I' =>
633 Ptr := Ptr + 1;
634 Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
635
636 -- -gnatel
637
638 when 'l' =>
639 Ptr := Ptr + 1;
640 Elab_Info_Messages := True;
641
642 -- -gnateL
643
644 when 'L' =>
645 Ptr := Ptr + 1;
646 Elab_Info_Messages := False;
647
648 -- -gnatem (mapping file)
649
650 when 'm' =>
651 Store_Switch := False;
652 Ptr := Ptr + 1;
653
654 -- There may be an equal sign between -gnatem and
655 -- the path name of the mapping file.
656
657 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
658 Ptr := Ptr + 1;
659 end if;
660
661 if Ptr > Max then
662 Bad_Switch ("-gnatem");
663 end if;
664
665 Mapping_File_Name :=
666 new String'(Switch_Chars (Ptr .. Max));
667 return;
668
669 -- -gnateO= (object path file)
670
671 -- This is an internal switch
672
673 when 'O' =>
674 Store_Switch := False;
675 Ptr := Ptr + 1;
676
677 -- Check for '='
678
679 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
680 Bad_Switch ("-gnateO");
681 else
682 Object_Path_File_Name :=
683 new String'(Switch_Chars (Ptr + 1 .. Max));
684 end if;
685
686 return;
687
688 -- -gnatep (preprocessing data file)
689
690 when 'p' =>
691 Store_Switch := False;
692 Ptr := Ptr + 1;
693
694 -- There may be an equal sign between -gnatep and
695 -- the path name of the mapping file.
696
697 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
698 Ptr := Ptr + 1;
699 end if;
700
701 if Ptr > Max then
702 Bad_Switch ("-gnatep");
703 end if;
704
705 Preprocessing_Data_File :=
706 new String'(Switch_Chars (Ptr .. Max));
707
708 -- Store the switch, normalizing to -gnatep=
709
710 Store_Compilation_Switch
711 ("-gnatep=" & Preprocessing_Data_File.all);
712
713 Ptr := Max + 1;
714
715 -- -gnateP (Treat pragma Pure/Preelaborate errs as warnings)
716
717 when 'P' =>
718 Treat_Categorization_Errors_As_Warnings := True;
719
720 -- -gnates=file (specify extra file switches for gnat2why)
721
722 -- This is an internal switch
723
724 when 's' =>
725 if not First_Switch then
726 Osint.Fail
727 ("-gnates must not be combined with other switches");
728 end if;
729
730 -- Check for '='
731
732 Ptr := Ptr + 1;
733
734 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
735 Bad_Switch ("-gnates");
736 else
737 SPARK_Switches_File_Name :=
738 new String'(Switch_Chars (Ptr + 1 .. Max));
739 end if;
740
741 return;
742
743 -- -gnateS (generate SCO information)
744
745 -- Include Source Coverage Obligation information in ALI
746 -- files for use by source coverage analysis tools
747 -- (gnatcov) (equivalent to -fdump-scos, provided for
748 -- backwards compatibility).
749
750 when 'S' =>
751 Generate_SCO := True;
752 Generate_SCO_Instance_Table := True;
753 Ptr := Ptr + 1;
754
755 -- -gnatet (write target dependent information)
756
757 when 't' =>
758 if not First_Switch then
759 Osint.Fail
760 ("-gnatet must not be combined with other switches");
761 end if;
762
763 -- Check for '='
764
765 Ptr := Ptr + 1;
766
767 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
768 Bad_Switch ("-gnatet");
769 else
770 Target_Dependent_Info_Write_Name :=
771 new String'(Switch_Chars (Ptr + 1 .. Max));
772 end if;
773
774 return;
775
776 -- -gnateT (read target dependent information)
777
778 when 'T' =>
779 if not First_Switch then
780 Osint.Fail
781 ("-gnateT must not be combined with other switches");
782 end if;
783
784 -- Check for '='
785
786 Ptr := Ptr + 1;
787
788 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
789 Bad_Switch ("-gnateT");
790 else
791 -- This parameter was stored by Set_Targ earlier
792
793 pragma Assert
794 (Target_Dependent_Info_Read_Name.all =
795 Switch_Chars (Ptr + 1 .. Max));
796 null;
797 end if;
798
799 return;
800
801 -- -gnateu (unrecognized y,V,w switches)
802
803 when 'u' =>
804 Ptr := Ptr + 1;
805 Ignore_Unrecognized_VWY_Switches := True;
806
807 -- -gnateV (validity checks on parameters)
808
809 when 'V' =>
810 Ptr := Ptr + 1;
811 Check_Validity_Of_Parameters := True;
812
813 -- -gnateY (ignore Style_Checks pragmas)
814
815 when 'Y' =>
816 Ignore_Style_Checks_Pragmas := True;
817 Ptr := Ptr + 1;
818
819 -- -gnatez (final delimiter of explicit switches)
820
821 -- This is an internal switch
822
823 -- All switches that come after -gnatez have been added by
824 -- the GCC driver and are not stored in the ALI file. See
825 -- also -gnatea above.
826
827 when 'z' =>
828 Store_Switch := False;
829 Disable_Switch_Storing;
830 Ptr := Ptr + 1;
831
832 -- All other -gnate? switches are unassigned
833
834 when others =>
835 Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max));
836 end case;
837
838 -- -gnatE (dynamic elaboration checks)
839
840 when 'E' =>
841 Ptr := Ptr + 1;
842 Dynamic_Elaboration_Checks := True;
843
844 -- -gnatf (full error messages)
845
846 when 'f' =>
847 Ptr := Ptr + 1;
848 All_Errors_Mode := True;
849
850 -- -gnatF (overflow of predefined float types)
851
852 when 'F' =>
853 Ptr := Ptr + 1;
854 External_Name_Exp_Casing := Uppercase;
855 External_Name_Imp_Casing := Uppercase;
856
857 -- -gnatg (GNAT implementation mode)
858
859 when 'g' =>
860 Ptr := Ptr + 1;
861 GNAT_Mode := True;
862 GNAT_Mode_Config := True;
863 Identifier_Character_Set := 'n';
864 System_Extend_Unit := Empty;
865 Warning_Mode := Treat_As_Error;
866 Style_Check_Main := True;
867 Ada_Version := Ada_2012;
868 Ada_Version_Explicit := Ada_2012;
869 Ada_Version_Pragma := Empty;
870
871 -- Set default warnings and style checks for -gnatg
872
873 Set_GNAT_Mode_Warnings;
874 Set_GNAT_Style_Check_Options;
875
876 -- -gnatG (output generated code)
877
878 when 'G' =>
879 Ptr := Ptr + 1;
880 Print_Generated_Code := True;
881
882 -- Scan optional integer line limit value
883
884 if Nat_Present (Switch_Chars, Max, Ptr) then
885 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G');
886 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
887 end if;
888
889 -- -gnath (help information)
890
891 when 'h' =>
892 Ptr := Ptr + 1;
893 Usage_Requested := True;
894
895 -- -gnati (character set)
896
897 when 'i' =>
898 if Ptr = Max then
899 Bad_Switch ("-gnati");
900 end if;
901
902 Ptr := Ptr + 1;
903 C := Switch_Chars (Ptr);
904
905 if C in '1' .. '5'
906 or else C = '8'
907 or else C = '9'
908 or else C = 'p'
909 or else C = 'f'
910 or else C = 'n'
911 or else C = 'w'
912 then
913 Identifier_Character_Set := C;
914 Ptr := Ptr + 1;
915
916 else
917 Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max));
918 end if;
919
920 -- -gnatI (ignore representation clauses)
921
922 when 'I' =>
923 Ptr := Ptr + 1;
924 Ignore_Rep_Clauses := True;
925
926 -- -gnatj (messages in limited length lines)
927
928 when 'j' =>
929 Ptr := Ptr + 1;
930 Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
931
932 -- -gnatk (limit file name length)
933
934 when 'k' =>
935 Ptr := Ptr + 1;
936 Scan_Pos
937 (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
938
939 -- -gnatl (output full source)
940
941 when 'l' =>
942 Ptr := Ptr + 1;
943 Full_List := True;
944
945 -- There may be an equal sign between -gnatl and a file name
946
947 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
948 if Ptr = Max then
949 Osint.Fail ("file name for -gnatl= is null");
950 else
951 Opt.Full_List_File_Name :=
952 new String'(Switch_Chars (Ptr + 1 .. Max));
953 Ptr := Max + 1;
954 end if;
955 end if;
956
957 -- -gnatL (corresponding source text)
958
959 when 'L' =>
960 Ptr := Ptr + 1;
961 Dump_Source_Text := True;
962
963 -- -gnatm (max number or errors/warnings)
964
965 when 'm' =>
966 Ptr := Ptr + 1;
967 Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C);
968
969 -- -gnatn (enable pragma Inline)
970
971 when 'n' =>
972 Ptr := Ptr + 1;
973 Inline_Active := True;
974
975 -- There may be a digit (1 or 2) appended to the switch
976
977 if Ptr <= Max then
978 C := Switch_Chars (Ptr);
979
980 if C in '1' .. '2' then
981 Ptr := Ptr + 1;
982 Inline_Level := Character'Pos (C) - Character'Pos ('0');
983 end if;
984 end if;
985
986 -- -gnatN (obsolescent)
987
988 when 'N' =>
989 Ptr := Ptr + 1;
990 Inline_Active := True;
991 Front_End_Inlining := True;
992
993 -- -gnato (overflow checks)
994
995 when 'o' =>
996 Ptr := Ptr + 1;
997
998 -- Case of -gnato0 (overflow checking turned off)
999
1000 if Ptr <= Max and then Switch_Chars (Ptr) = '0' then
1001 Ptr := Ptr + 1;
1002 Suppress_Options.Suppress (Overflow_Check) := True;
1003
1004 -- We set strict mode in case overflow checking is turned
1005 -- on locally (also records that we had a -gnato switch).
1006
1007 Suppress_Options.Overflow_Mode_General := Strict;
1008 Suppress_Options.Overflow_Mode_Assertions := Strict;
1009
1010 -- All cases other than -gnato0 (overflow checking turned on)
1011
1012 else
1013 Suppress_Options.Suppress (Overflow_Check) := False;
1014
1015 -- Case of no digits after the -gnato
1016
1017 if Ptr > Max
1018 or else Switch_Chars (Ptr) not in '1' .. '3'
1019 then
1020 Suppress_Options.Overflow_Mode_General := Strict;
1021 Suppress_Options.Overflow_Mode_Assertions := Strict;
1022
1023 -- At least one digit after the -gnato
1024
1025 else
1026 -- Handle first digit after -gnato
1027
1028 Suppress_Options.Overflow_Mode_General :=
1029 Get_Overflow_Mode (Switch_Chars (Ptr));
1030 Ptr := Ptr + 1;
1031
1032 -- Only one digit after -gnato, set assertions mode to be
1033 -- the same as general mode.
1034
1035 if Ptr > Max
1036 or else Switch_Chars (Ptr) not in '1' .. '3'
1037 then
1038 Suppress_Options.Overflow_Mode_Assertions :=
1039 Suppress_Options.Overflow_Mode_General;
1040
1041 -- Process second digit after -gnato
1042
1043 else
1044 Suppress_Options.Overflow_Mode_Assertions :=
1045 Get_Overflow_Mode (Switch_Chars (Ptr));
1046 Ptr := Ptr + 1;
1047 end if;
1048 end if;
1049 end if;
1050
1051 -- -gnatO (specify name of the object file)
1052
1053 -- This is an internal switch
1054
1055 when 'O' =>
1056 Store_Switch := False;
1057 Ptr := Ptr + 1;
1058 Output_File_Name_Present := True;
1059
1060 -- -gnatp (suppress all checks)
1061
1062 when 'p' =>
1063 Ptr := Ptr + 1;
1064
1065 -- Skip processing if cancelled by subsequent -gnat-p
1066
1067 if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then
1068 Store_Switch := False;
1069
1070 else
1071 -- Set all specific options as well as All_Checks in the
1072 -- Suppress_Options array, excluding Elaboration_Check,
1073 -- since this is treated specially because we do not want
1074 -- -gnatp to disable static elaboration processing. Also
1075 -- exclude Atomic_Synchronization, since this is not a real
1076 -- check.
1077
1078 for J in Suppress_Options.Suppress'Range loop
1079 if J /= Elaboration_Check
1080 and then
1081 J /= Atomic_Synchronization
1082 then
1083 Suppress_Options.Suppress (J) := True;
1084 end if;
1085 end loop;
1086
1087 Validity_Checks_On := False;
1088 Opt.Suppress_Checks := True;
1089
1090 -- Set overflow mode checking to strict in case it gets
1091 -- turned on locally (also signals that overflow checking
1092 -- has been specifically turned off).
1093
1094 Suppress_Options.Overflow_Mode_General := Strict;
1095 Suppress_Options.Overflow_Mode_Assertions := Strict;
1096 end if;
1097
1098 -- -gnatP (periodic poll)
1099
1100 when 'P' =>
1101 Ptr := Ptr + 1;
1102 Polling_Required := True;
1103
1104 -- -gnatq (don't quit)
1105
1106 when 'q' =>
1107 Ptr := Ptr + 1;
1108 Try_Semantics := True;
1109
1110 -- -gnatQ (always write ALI file)
1111
1112 when 'Q' =>
1113 Ptr := Ptr + 1;
1114 Force_ALI_Tree_File := True;
1115 Try_Semantics := True;
1116
1117 -- -gnatr (restrictions as warnings)
1118
1119 when 'r' =>
1120 Ptr := Ptr + 1;
1121 Treat_Restrictions_As_Warnings := True;
1122
1123 -- -gnatR (list rep. info)
1124
1125 when 'R' =>
1126
1127 -- Not allowed if previous -gnatD given. See more extensive
1128 -- comments in the 'D' section for the inverse test.
1129
1130 if Debug_Generated_Code then
1131 Osint.Fail
1132 ("-gnatR not permitted since -gnatD given previously");
1133 end if;
1134
1135 -- Set to annotate rep info, and set default -gnatR mode
1136
1137 Back_Annotate_Rep_Info := True;
1138 List_Representation_Info := 1;
1139
1140 -- Scan possible parameter
1141
1142 Ptr := Ptr + 1;
1143 while Ptr <= Max loop
1144 C := Switch_Chars (Ptr);
1145
1146 if C in '1' .. '3' then
1147 List_Representation_Info :=
1148 Character'Pos (C) - Character'Pos ('0');
1149
1150 elsif Switch_Chars (Ptr) = 's' then
1151 List_Representation_Info_To_File := True;
1152
1153 elsif Switch_Chars (Ptr) = 'm' then
1154 List_Representation_Info_Mechanisms := True;
1155
1156 else
1157 Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
1158 end if;
1159
1160 Ptr := Ptr + 1;
1161 end loop;
1162
1163 -- -gnats (syntax check only)
1164
1165 when 's' =>
1166 if not First_Switch then
1167 Osint.Fail
1168 ("-gnats must be first if combined with other switches");
1169 end if;
1170
1171 Ptr := Ptr + 1;
1172 Operating_Mode := Check_Syntax;
1173
1174 -- -gnatS (print package Standard)
1175
1176 when 'S' =>
1177 Print_Standard := True;
1178 Ptr := Ptr + 1;
1179
1180 -- -gnatt (output tree)
1181
1182 when 't' =>
1183 Ptr := Ptr + 1;
1184 Tree_Output := True;
1185 Back_Annotate_Rep_Info := True;
1186
1187 -- -gnatT (change start of internal table sizes)
1188
1189 when 'T' =>
1190 Ptr := Ptr + 1;
1191 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
1192
1193 -- -gnatu (list units for compilation)
1194
1195 when 'u' =>
1196 Ptr := Ptr + 1;
1197 List_Units := True;
1198
1199 -- -gnatU (unique tags)
1200
1201 when 'U' =>
1202 Ptr := Ptr + 1;
1203 Unique_Error_Tag := True;
1204
1205 -- -gnatv (verbose mode)
1206
1207 when 'v' =>
1208 Ptr := Ptr + 1;
1209 Verbose_Mode := True;
1210
1211 -- -gnatV (validity checks)
1212
1213 when 'V' =>
1214 Store_Switch := False;
1215 Ptr := Ptr + 1;
1216
1217 if Ptr > Max then
1218 Bad_Switch ("-gnatV");
1219
1220 else
1221 declare
1222 OK : Boolean;
1223
1224 begin
1225 Set_Validity_Check_Options
1226 (Switch_Chars (Ptr .. Max), OK, Ptr);
1227
1228 if not OK then
1229 Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max));
1230 end if;
1231
1232 for Index in First_Char + 1 .. Max loop
1233 Store_Compilation_Switch
1234 ("-gnatV" & Switch_Chars (Index));
1235 end loop;
1236 end;
1237 end if;
1238
1239 Ptr := Max + 1;
1240
1241 -- -gnatw (warning modes)
1242
1243 when 'w' =>
1244 Store_Switch := False;
1245 Ptr := Ptr + 1;
1246
1247 if Ptr > Max then
1248 Bad_Switch ("-gnatw");
1249 end if;
1250
1251 while Ptr <= Max loop
1252 C := Switch_Chars (Ptr);
1253
1254 -- Case of dot switch
1255
1256 if C = '.' and then Ptr < Max then
1257 Ptr := Ptr + 1;
1258 C := Switch_Chars (Ptr);
1259
1260 if Set_Dot_Warning_Switch (C) then
1261 Store_Compilation_Switch ("-gnatw." & C);
1262 else
1263 Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max));
1264 end if;
1265
1266 -- Normal case, no dot
1267
1268 else
1269 if Set_Warning_Switch (C) then
1270 Store_Compilation_Switch ("-gnatw" & C);
1271 else
1272 Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max));
1273 end if;
1274 end if;
1275
1276 Ptr := Ptr + 1;
1277 end loop;
1278
1279 return;
1280
1281 -- -gnatW (wide character encoding method)
1282
1283 when 'W' =>
1284 Ptr := Ptr + 1;
1285
1286 if Ptr > Max then
1287 Bad_Switch ("-gnatW");
1288 end if;
1289
1290 begin
1291 Wide_Character_Encoding_Method :=
1292 Get_WC_Encoding_Method (Switch_Chars (Ptr));
1293 exception
1294 when Constraint_Error =>
1295 Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max));
1296 end;
1297
1298 Wide_Character_Encoding_Method_Specified := True;
1299
1300 Upper_Half_Encoding :=
1301 Wide_Character_Encoding_Method in
1302 WC_Upper_Half_Encoding_Method;
1303
1304 Ptr := Ptr + 1;
1305
1306 -- -gnatx (suppress cross-ref information)
1307
1308 when 'x' =>
1309 Ptr := Ptr + 1;
1310 Xref_Active := False;
1311
1312 -- -gnatX (language extensions)
1313
1314 when 'X' =>
1315 Ptr := Ptr + 1;
1316 Extensions_Allowed := True;
1317 Ada_Version := Ada_Version_Type'Last;
1318 Ada_Version_Explicit := Ada_Version_Type'Last;
1319 Ada_Version_Pragma := Empty;
1320
1321 -- -gnaty (style checks)
1322
1323 when 'y' =>
1324 Ptr := Ptr + 1;
1325 Style_Check_Main := True;
1326
1327 if Ptr > Max then
1328 Set_Default_Style_Check_Options;
1329
1330 else
1331 Store_Switch := False;
1332
1333 declare
1334 OK : Boolean;
1335
1336 begin
1337 Set_Style_Check_Options
1338 (Switch_Chars (Ptr .. Max), OK, Ptr);
1339
1340 if not OK then
1341 Osint.Fail
1342 ("bad -gnaty switch (" &
1343 Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
1344 end if;
1345
1346 Ptr := First_Char + 1;
1347 while Ptr <= Max loop
1348 if Switch_Chars (Ptr) = 'M' then
1349 First_Char := Ptr;
1350 loop
1351 Ptr := Ptr + 1;
1352 exit when Ptr > Max
1353 or else Switch_Chars (Ptr) not in '0' .. '9';
1354 end loop;
1355
1356 Store_Compilation_Switch
1357 ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1));
1358
1359 else
1360 Store_Compilation_Switch
1361 ("-gnaty" & Switch_Chars (Ptr));
1362 Ptr := Ptr + 1;
1363 end if;
1364 end loop;
1365 end;
1366 end if;
1367
1368 -- -gnatz (stub generation)
1369
1370 when 'z' =>
1371
1372 -- -gnatz must be the first and only switch in Switch_Chars,
1373 -- and is a two-letter switch.
1374
1375 if Ptr /= Switch_Chars'First + 5
1376 or else (Max - Ptr + 1) > 2
1377 then
1378 Osint.Fail
1379 ("-gnatz* may not be combined with other switches");
1380 end if;
1381
1382 if Ptr = Max then
1383 Bad_Switch ("-gnatz");
1384 end if;
1385
1386 Ptr := Ptr + 1;
1387
1388 -- Only one occurrence of -gnat* is permitted
1389
1390 if Distribution_Stub_Mode = No_Stubs then
1391 case Switch_Chars (Ptr) is
1392 when 'r' =>
1393 Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
1394
1395 when 'c' =>
1396 Distribution_Stub_Mode := Generate_Caller_Stub_Body;
1397
1398 when others =>
1399 Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
1400 end case;
1401
1402 Ptr := Ptr + 1;
1403
1404 else
1405 Osint.Fail ("only one -gnatz* switch allowed");
1406 end if;
1407
1408 -- -gnatZ (obsolescent)
1409
1410 when 'Z' =>
1411 Ptr := Ptr + 1;
1412 Osint.Fail
1413 ("-gnatZ is no longer supported: consider using --RTS=zcx");
1414
1415 -- Note on language version switches: whenever a new language
1416 -- version switch is added, Switch.M.Normalize_Compiler_Switches
1417 -- must be updated.
1418
1419 -- -gnat83
1420
1421 when '8' =>
1422 if Ptr = Max then
1423 Bad_Switch ("-gnat8");
1424 end if;
1425
1426 Ptr := Ptr + 1;
1427
1428 if Switch_Chars (Ptr) /= '3' or else Latest_Ada_Only then
1429 Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
1430 else
1431 Ptr := Ptr + 1;
1432 Ada_Version := Ada_83;
1433 Ada_Version_Explicit := Ada_83;
1434 Ada_Version_Pragma := Empty;
1435 end if;
1436
1437 -- -gnat95
1438
1439 when '9' =>
1440 if Ptr = Max then
1441 Bad_Switch ("-gnat9");
1442 end if;
1443
1444 Ptr := Ptr + 1;
1445
1446 if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
1447 Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
1448 else
1449 Ptr := Ptr + 1;
1450 Ada_Version := Ada_95;
1451 Ada_Version_Explicit := Ada_95;
1452 Ada_Version_Pragma := Empty;
1453 end if;
1454
1455 -- -gnat05
1456
1457 when '0' =>
1458 if Ptr = Max then
1459 Bad_Switch ("-gnat0");
1460 end if;
1461
1462 Ptr := Ptr + 1;
1463
1464 if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
1465 Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
1466 else
1467 Ptr := Ptr + 1;
1468 Ada_Version := Ada_2005;
1469 Ada_Version_Explicit := Ada_2005;
1470 Ada_Version_Pragma := Empty;
1471 end if;
1472
1473 -- -gnat12
1474
1475 when '1' =>
1476 if Ptr = Max then
1477 Bad_Switch ("-gnat1");
1478 end if;
1479
1480 Ptr := Ptr + 1;
1481
1482 if Switch_Chars (Ptr) /= '2' then
1483 Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
1484 else
1485 Ptr := Ptr + 1;
1486 Ada_Version := Ada_2012;
1487 Ada_Version_Explicit := Ada_2012;
1488 Ada_Version_Pragma := Empty;
1489 end if;
1490
1491 -- -gnat2005 and -gnat2012
1492
1493 when '2' =>
1494 if Ptr > Max - 3 then
1495 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1496
1497 elsif Switch_Chars (Ptr .. Ptr + 3) = "2005"
1498 and then not Latest_Ada_Only
1499 then
1500 Ada_Version := Ada_2005;
1501
1502 elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
1503 Ada_Version := Ada_2012;
1504
1505 else
1506 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
1507 end if;
1508
1509 Ada_Version_Explicit := Ada_Version;
1510 Ada_Version_Pragma := Empty;
1511 Ptr := Ptr + 4;
1512
1513 -- Switch cancellation, currently only -gnat-p is allowed.
1514 -- All we do here is the error checking, since the actual
1515 -- processing for switch cancellation is done by calls to
1516 -- Switch_Subsequently_Cancelled at the appropriate point.
1517
1518 when '-' =>
1519
1520 -- Simple ignore -gnat-p
1521
1522 if Switch_Chars = "-gnat-p" then
1523 return;
1524
1525 -- Any other occurrence of minus is ignored. This is for
1526 -- maximum compatibility with previous version which ignored
1527 -- all occurrences of minus.
1528
1529 else
1530 Store_Switch := False;
1531 Ptr := Ptr + 1;
1532 end if;
1533
1534 -- We ignore '/' in switches, this is historical, still needed???
1535
1536 when '/' =>
1537 Store_Switch := False;
1538
1539 -- Anything else is an error (illegal switch character)
1540
1541 when others =>
1542 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1543 end case;
1544
1545 if Store_Switch then
1546 Store_Compilation_Switch
1547 ("-gnat" & Switch_Chars (First_Char .. Ptr - 1));
1548 end if;
1549
1550 First_Switch := False;
1551 end loop;
1552 end if;
1553 end Scan_Front_End_Switches;
1554
1555 -----------------------------------
1556 -- Switch_Subsequently_Cancelled --
1557 -----------------------------------
1558
1559 function Switch_Subsequently_Cancelled
1560 (C : String;
1561 Args : String_List;
1562 Arg_Rank : Positive) return Boolean
1563 is
1564 begin
1565 -- Loop through arguments following the current one
1566
1567 for Arg in Arg_Rank + 1 .. Args'Last loop
1568 if Args (Arg).all = "-gnat-" & C then
1569 return True;
1570 end if;
1571 end loop;
1572
1573 -- No match found, not cancelled
1574
1575 return False;
1576 end Switch_Subsequently_Cancelled;
1577
1578 end Switch.C;