e5e953683920f9a96bb4673ab9bdf82fbcfa5b95
[gcc.git] / gcc / ada / 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-2003 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 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. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
26
27 with GNAT.OS_Lib; use GNAT.OS_Lib;
28
29 with Debug; use Debug;
30 with Lib; use Lib;
31 with Osint; use Osint;
32 with Opt; use Opt;
33 with Prepcomp; use Prepcomp;
34 with Types; use Types;
35 with Validsw; use Validsw;
36 with Stylesw; use Stylesw;
37
38 with System.WCh_Con; use System.WCh_Con;
39
40 package body Switch.C is
41
42 RTS_Specified : String_Access := null;
43 -- Used to detect multiple use of --RTS= flag
44
45 -----------------------------
46 -- Scan_Front_End_Switches --
47 -----------------------------
48
49 procedure Scan_Front_End_Switches (Switch_Chars : String) is
50 Switch_Starts_With_Gnat : Boolean;
51 -- True if first four switch characters are "gnat"
52
53 First_Switch : Boolean := True;
54 -- False for all but first switch
55
56 Ptr : Integer := Switch_Chars'First;
57 Max : constant Integer := Switch_Chars'Last;
58 C : Character := ' ';
59 Dot : Boolean;
60
61 Store_Switch : Boolean := True;
62 First_Char : Integer := Ptr;
63 Storing : String := Switch_Chars;
64 First_Stored : Positive := Ptr + 1;
65 -- The above need comments ???
66
67 begin
68 -- Skip past the initial character (must be the switch character)
69
70 if Ptr = Max then
71 raise Bad_Switch;
72 else
73 Ptr := Ptr + 1;
74 end if;
75
76 -- Remove "gnat" from the switch, if present
77
78 Switch_Starts_With_Gnat :=
79 Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
80
81 if Switch_Starts_With_Gnat then
82 Ptr := Ptr + 4;
83 First_Stored := Ptr;
84 end if;
85
86 -- Loop to scan through switches given in switch string
87
88 while Ptr <= Max loop
89 Store_Switch := True;
90 First_Char := Ptr;
91 C := Switch_Chars (Ptr);
92
93 -- Processing for a switch
94
95 case Switch_Starts_With_Gnat is
96
97 when False =>
98
99 -- There are only two front-end switches that
100 -- do not start with -gnat, namely -I and --RTS
101
102 if Switch_Chars (Ptr) = 'I' then
103 Store_Switch := False;
104
105 Ptr := Ptr + 1;
106
107 if Ptr > Max then
108 raise Bad_Switch;
109 end if;
110
111 -- Find out whether this is a -I- or regular -Ixxx switch
112
113 if Ptr = Max and then Switch_Chars (Ptr) = '-' then
114 Look_In_Primary_Dir := False;
115
116 else
117 Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
118 end if;
119
120 Ptr := Max + 1;
121
122 -- Processing of the --RTS switch. --RTS has been modified by
123 -- gcc and is now of the form -fRTS
124
125 elsif Ptr + 3 <= Max
126 and then Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
127 then
128 Ptr := Ptr + 1;
129
130 if Ptr + 4 > Max
131 or else Switch_Chars (Ptr + 3) /= '='
132 then
133 Osint.Fail ("missing path for --RTS");
134 else
135 -- Check that this is the first time --RTS is specified
136 -- or if it is not the first time, the same path has
137 -- been specified.
138
139 if RTS_Specified = null then
140 RTS_Specified :=
141 new String'(Switch_Chars (Ptr + 4 .. Max));
142
143 elsif
144 RTS_Specified.all /= Switch_Chars (Ptr + 4 .. Max)
145 then
146 Osint.Fail
147 ("--RTS cannot be specified multiple times");
148 end if;
149
150 -- Valid --RTS switch
151
152 Opt.No_Stdinc := True;
153 Opt.RTS_Switch := True;
154
155 RTS_Src_Path_Name := Get_RTS_Search_Dir
156 (Switch_Chars (Ptr + 4 .. Max),
157 Include);
158 RTS_Lib_Path_Name := Get_RTS_Search_Dir
159 (Switch_Chars (Ptr + 4 .. Max),
160 Objects);
161
162 if RTS_Src_Path_Name /= null and then
163 RTS_Lib_Path_Name /= null
164 then
165 Ptr := Max + 1;
166
167 elsif RTS_Src_Path_Name = null and then
168 RTS_Lib_Path_Name = null
169 then
170 Osint.Fail ("RTS path not valid: missing " &
171 "adainclude and adalib directories");
172
173 elsif RTS_Src_Path_Name = null then
174 Osint.Fail ("RTS path not valid: missing " &
175 "adainclude directory");
176
177 elsif RTS_Lib_Path_Name = null then
178 Osint.Fail ("RTS path not valid: missing " &
179 "adalib directory");
180 end if;
181 end if;
182 else
183 raise Bad_Switch;
184 end if;
185
186 when True =>
187
188 -- Process -gnat* options
189
190 case C is
191
192 when 'a' =>
193 Ptr := Ptr + 1;
194 Assertions_Enabled := True;
195
196 -- Processing for A switch
197
198 when 'A' =>
199 Ptr := Ptr + 1;
200 Config_File := False;
201
202 -- Processing for b switch
203
204 when 'b' =>
205 Ptr := Ptr + 1;
206 Brief_Output := True;
207
208 -- Processing for c switch
209
210 when 'c' =>
211 if not First_Switch then
212 Osint.Fail
213 ("-gnatc must be first if combined with other switches");
214 end if;
215
216 Ptr := Ptr + 1;
217 Operating_Mode := Check_Semantics;
218
219 if Tree_Output then
220 ASIS_Mode := True;
221 end if;
222
223 -- Processing for d switch
224
225 when 'd' =>
226 Store_Switch := False;
227 Storing (First_Stored) := 'd';
228 Dot := False;
229
230 -- Note: for the debug switch, the remaining characters in this
231 -- switch field must all be debug flags, since all valid switch
232 -- characters are also valid debug characters.
233
234 -- Loop to scan out debug flags
235
236 while Ptr < Max loop
237 Ptr := Ptr + 1;
238 C := Switch_Chars (Ptr);
239 exit when C = ASCII.NUL or else C = '/' or else C = '-';
240
241 if C in '1' .. '9' or else
242 C in 'a' .. 'z' or else
243 C in 'A' .. 'Z'
244 then
245 if Dot then
246 Set_Dotted_Debug_Flag (C);
247 Storing (First_Stored + 1) := '.';
248 Storing (First_Stored + 2) := C;
249 Store_Compilation_Switch
250 (Storing (Storing'First .. First_Stored + 2));
251 Dot := False;
252
253 else
254 Set_Debug_Flag (C);
255 Storing (First_Stored + 1) := C;
256 Store_Compilation_Switch
257 (Storing (Storing'First .. First_Stored + 1));
258 end if;
259
260 elsif C = '.' then
261 Dot := True;
262
263 else
264 raise Bad_Switch;
265 end if;
266 end loop;
267
268 -- Make sure Zero_Cost_Exceptions is set if gnatdX set. This
269 -- is for backwards compatibility with old versions and usage.
270
271 if Debug_Flag_XX then
272 Zero_Cost_Exceptions_Set := True;
273 Zero_Cost_Exceptions_Val := True;
274 end if;
275
276 return;
277
278 -- Processing for D switch
279
280 when 'D' =>
281 Ptr := Ptr + 1;
282
283 -- Note: -gnatD also sets -gnatx (to turn off cross-reference
284 -- generation in the ali file) since otherwise this generation
285 -- gets confused by the "wrong" Sloc values put in the tree.
286
287 Debug_Generated_Code := True;
288 Xref_Active := False;
289 Set_Debug_Flag ('g');
290
291 -- Processing for e switch
292
293 when 'e' =>
294 -- Only -gnateD and -gnatep= are stored
295
296 Ptr := Ptr + 1;
297
298 if Ptr > Max then
299 raise Bad_Switch;
300 end if;
301
302 case Switch_Chars (Ptr) is
303
304 -- Configuration pragmas
305
306 when 'c' =>
307 Store_Switch := False;
308 Ptr := Ptr + 1;
309
310 -- There may be an equal sign between -gnatec and
311 -- the path name of the config file.
312
313 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
314 Ptr := Ptr + 1;
315 end if;
316
317 if Ptr > Max then
318 raise Bad_Switch;
319 end if;
320
321 declare
322 Config_File_Name : constant String_Access :=
323 new String'
324 (Switch_Chars (Ptr .. Max));
325
326 begin
327 if Config_File_Names = null then
328 Config_File_Names :=
329 new String_List'(1 => Config_File_Name);
330
331 else
332 declare
333 New_Names : constant String_List_Access :=
334 new String_List
335 (1 ..
336 Config_File_Names'Length + 1);
337
338 begin
339 for Index in Config_File_Names'Range loop
340 New_Names (Index) :=
341 Config_File_Names (Index);
342 Config_File_Names (Index) := null;
343 end loop;
344
345 New_Names (New_Names'Last) := Config_File_Name;
346 Free (Config_File_Names);
347 Config_File_Names := New_Names;
348 end;
349 end if;
350 end;
351
352 return;
353
354 -- Symbol definition
355
356 when 'D' =>
357 Store_Switch := False;
358 Ptr := Ptr + 1;
359
360 if Ptr > Max then
361 raise Bad_Switch;
362 end if;
363
364 Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
365
366 -- Store the switch
367
368 Storing (First_Stored .. First_Stored + 1) := "eD";
369 Storing
370 (First_Stored + 2 .. First_Stored + Max - Ptr + 2) :=
371 Switch_Chars (Ptr .. Max);
372 Store_Compilation_Switch (Storing
373 (Storing'First .. First_Stored + Max - Ptr + 2));
374 return;
375
376 -- Full source path for brief error messages
377
378 when 'f' =>
379 Store_Switch := False;
380 Ptr := Ptr + 1;
381 Full_Path_Name_For_Brief_Errors := True;
382 return;
383
384 -- Mapping file
385
386 when 'm' =>
387 Store_Switch := False;
388 Ptr := Ptr + 1;
389
390 -- There may be an equal sign between -gnatem and
391 -- the path name of the mapping file.
392
393 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
394 Ptr := Ptr + 1;
395 end if;
396
397 if Ptr > Max then
398 raise Bad_Switch;
399 end if;
400
401 Mapping_File_Name :=
402 new String'(Switch_Chars (Ptr .. Max));
403 return;
404
405 -- Preprocessing data file
406
407 when 'p' =>
408 Store_Switch := False;
409 Ptr := Ptr + 1;
410
411 -- There may be an equal sign between -gnatep and
412 -- the path name of the mapping file.
413
414 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
415 Ptr := Ptr + 1;
416 end if;
417
418 if Ptr > Max then
419 raise Bad_Switch;
420 end if;
421
422 Preprocessing_Data_File :=
423 new String'(Switch_Chars (Ptr .. Max));
424
425 -- Store the switch.
426 -- Because we may store a longer switch (we normalize
427 -- to -gnatep=), use a local variable.
428
429 declare
430 To_Store : String
431 (1 .. Preprocessing_Data_File'Length + 8);
432
433 begin
434 To_Store (1 .. 8) := "-gnatep=";
435 To_Store (9 .. Preprocessing_Data_File'Length + 8) :=
436 Preprocessing_Data_File.all;
437 Store_Compilation_Switch (To_Store);
438 end;
439
440 return;
441
442 when others =>
443 raise Bad_Switch;
444 end case;
445
446 -- Processing for E switch
447
448 when 'E' =>
449 Ptr := Ptr + 1;
450 Dynamic_Elaboration_Checks := True;
451
452 -- Processing for f switch
453
454 when 'f' =>
455 Ptr := Ptr + 1;
456 All_Errors_Mode := True;
457
458 -- Processing for F switch
459
460 when 'F' =>
461 Ptr := Ptr + 1;
462 External_Name_Exp_Casing := Uppercase;
463 External_Name_Imp_Casing := Uppercase;
464
465 -- Processing for g switch
466
467 when 'g' =>
468 Ptr := Ptr + 1;
469 GNAT_Mode := True;
470 Identifier_Character_Set := 'n';
471 Warning_Mode := Treat_As_Error;
472 Check_Unreferenced := True;
473 Check_Withs := True;
474 Check_Unreferenced_Formals := True;
475 System_Extend_Unit := Empty;
476
477 Set_Default_Style_Check_Options;
478
479 -- Processing for G switch
480
481 when 'G' =>
482 Ptr := Ptr + 1;
483 Print_Generated_Code := True;
484
485 -- Processing for h switch
486
487 when 'h' =>
488 Ptr := Ptr + 1;
489 Usage_Requested := True;
490
491 -- Processing for H switch
492
493 when 'H' =>
494 Ptr := Ptr + 1;
495 HLO_Active := True;
496
497 -- Processing for i switch
498
499 when 'i' =>
500 if Ptr = Max then
501 raise Bad_Switch;
502 end if;
503
504 Ptr := Ptr + 1;
505 C := Switch_Chars (Ptr);
506
507 if C in '1' .. '5'
508 or else C = '8'
509 or else C = '9'
510 or else C = 'p'
511 or else C = 'f'
512 or else C = 'n'
513 or else C = 'w'
514 then
515 Identifier_Character_Set := C;
516 Ptr := Ptr + 1;
517
518 else
519 raise Bad_Switch;
520 end if;
521
522 -- Processing for k switch
523
524 when 'k' =>
525 Ptr := Ptr + 1;
526 Scan_Pos (Switch_Chars, Max, Ptr, Maximum_File_Name_Length);
527
528 -- Processing for l switch
529
530 when 'l' =>
531 Ptr := Ptr + 1;
532 Full_List := True;
533
534 -- Processing for L switch
535
536 when 'L' =>
537 Ptr := Ptr + 1;
538 Zero_Cost_Exceptions_Set := True;
539 Zero_Cost_Exceptions_Val := False;
540
541 -- Processing for m switch
542
543 when 'm' =>
544 Ptr := Ptr + 1;
545 Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
546
547 -- Processing for n switch
548
549 when 'n' =>
550 Ptr := Ptr + 1;
551 Inline_Active := True;
552
553 -- Processing for N switch
554
555 when 'N' =>
556 Ptr := Ptr + 1;
557 Inline_Active := True;
558 Front_End_Inlining := True;
559
560 -- Processing for o switch
561
562 when 'o' =>
563 Ptr := Ptr + 1;
564 Suppress_Options (Overflow_Check) := False;
565 Opt.Enable_Overflow_Checks := True;
566
567 -- Processing for O switch
568
569 when 'O' =>
570 Store_Switch := False;
571 Ptr := Ptr + 1;
572 Output_File_Name_Present := True;
573
574 -- Processing for p switch
575
576 when 'p' =>
577 Ptr := Ptr + 1;
578 Suppress_Options := (others => True);
579 Validity_Checks_On := False;
580 Opt.Suppress_Checks := True;
581 Opt.Enable_Overflow_Checks := False;
582
583 -- Processing for P switch
584
585 when 'P' =>
586 Ptr := Ptr + 1;
587 Polling_Required := True;
588
589 -- Processing for q switch
590
591 when 'q' =>
592 Ptr := Ptr + 1;
593 Try_Semantics := True;
594
595 -- Processing for q switch
596
597 when 'Q' =>
598 Ptr := Ptr + 1;
599 Force_ALI_Tree_File := True;
600 Try_Semantics := True;
601
602 -- Processing for R switch
603
604 when 'R' =>
605 Ptr := Ptr + 1;
606 Back_Annotate_Rep_Info := True;
607 List_Representation_Info := 1;
608
609 while Ptr <= Max loop
610 C := Switch_Chars (Ptr);
611
612 if C in '1' .. '3' then
613 List_Representation_Info :=
614 Character'Pos (C) - Character'Pos ('0');
615
616 elsif Switch_Chars (Ptr) = 's' then
617 List_Representation_Info_To_File := True;
618
619 elsif Switch_Chars (Ptr) = 'm' then
620 List_Representation_Info_Mechanisms := True;
621
622 else
623 raise Bad_Switch;
624 end if;
625
626 Ptr := Ptr + 1;
627 end loop;
628
629 -- Processing for s switch
630
631 when 's' =>
632 if not First_Switch then
633 Osint.Fail
634 ("-gnats must be first if combined with other switches");
635 end if;
636
637 Ptr := Ptr + 1;
638 Operating_Mode := Check_Syntax;
639
640 -- Processing for t switch
641
642 when 't' =>
643 Ptr := Ptr + 1;
644 Tree_Output := True;
645
646 if Operating_Mode = Check_Semantics then
647 ASIS_Mode := True;
648 end if;
649
650 Back_Annotate_Rep_Info := True;
651
652 -- Processing for T switch
653
654 when 'T' =>
655 Ptr := Ptr + 1;
656 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor);
657
658 -- Processing for u switch
659
660 when 'u' =>
661 Ptr := Ptr + 1;
662 List_Units := True;
663
664 -- Processing for U switch
665
666 when 'U' =>
667 Ptr := Ptr + 1;
668 Unique_Error_Tag := True;
669
670 -- Processing for v switch
671
672 when 'v' =>
673 Ptr := Ptr + 1;
674 Verbose_Mode := True;
675
676 -- Processing for V switch
677
678 when 'V' =>
679 Store_Switch := False;
680 Storing (First_Stored) := 'V';
681 Ptr := Ptr + 1;
682
683 if Ptr > Max then
684 raise Bad_Switch;
685
686 else
687 declare
688 OK : Boolean;
689
690 begin
691 Set_Validity_Check_Options
692 (Switch_Chars (Ptr .. Max), OK, Ptr);
693
694 if not OK then
695 raise Bad_Switch;
696 end if;
697
698 for Index in First_Char + 1 .. Max loop
699 Storing (First_Stored + 1) :=
700 Switch_Chars (Index);
701 Store_Compilation_Switch
702 (Storing (Storing'First .. First_Stored + 1));
703 end loop;
704 end;
705 end if;
706
707 Ptr := Max + 1;
708
709 -- Processing for w switch
710
711 when 'w' =>
712 Store_Switch := False;
713 Storing (First_Stored) := 'w';
714 Ptr := Ptr + 1;
715
716 if Ptr > Max then
717 raise Bad_Switch;
718 end if;
719
720 while Ptr <= Max loop
721 C := Switch_Chars (Ptr);
722
723 case C is
724 when 'a' =>
725 Check_Unreferenced := True;
726 Check_Unreferenced_Formals := True;
727 Check_Withs := True;
728 Constant_Condition_Warnings := True;
729 Implementation_Unit_Warnings := True;
730 Ineffective_Inline_Warnings := True;
731 Warn_On_Constant := True;
732 Warn_On_Export_Import := True;
733 Warn_On_Modified_Unread := True;
734 Warn_On_No_Value_Assigned := True;
735 Warn_On_Obsolescent_Feature := True;
736 Warn_On_Redundant_Constructs := True;
737 Warn_On_Unchecked_Conversion := True;
738 Warn_On_Unrecognized_Pragma := True;
739
740 when 'A' =>
741 Check_Unreferenced := False;
742 Check_Unreferenced_Formals := False;
743 Check_Withs := False;
744 Constant_Condition_Warnings := False;
745 Elab_Warnings := False;
746 Implementation_Unit_Warnings := False;
747 Ineffective_Inline_Warnings := False;
748 Warn_On_Constant := False;
749 Warn_On_Dereference := False;
750 Warn_On_Export_Import := False;
751 Warn_On_Hiding := False;
752 Warn_On_Modified_Unread := False;
753 Warn_On_No_Value_Assigned := False;
754 Warn_On_Obsolescent_Feature := False;
755 Warn_On_Redundant_Constructs := False;
756 Warn_On_Unchecked_Conversion := False;
757 Warn_On_Unrecognized_Pragma := False;
758
759 when 'c' =>
760 Constant_Condition_Warnings := True;
761
762 when 'C' =>
763 Constant_Condition_Warnings := False;
764
765 when 'd' =>
766 Warn_On_Dereference := True;
767
768 when 'D' =>
769 Warn_On_Dereference := False;
770
771 when 'e' =>
772 Warning_Mode := Treat_As_Error;
773
774 when 'f' =>
775 Check_Unreferenced_Formals := True;
776
777 when 'F' =>
778 Check_Unreferenced_Formals := False;
779
780 when 'g' =>
781 Warn_On_Unrecognized_Pragma := True;
782
783 when 'G' =>
784 Warn_On_Unrecognized_Pragma := False;
785
786 when 'h' =>
787 Warn_On_Hiding := True;
788
789 when 'H' =>
790 Warn_On_Hiding := False;
791
792 when 'i' =>
793 Implementation_Unit_Warnings := True;
794
795 when 'I' =>
796 Implementation_Unit_Warnings := False;
797
798 when 'j' =>
799 Warn_On_Obsolescent_Feature := True;
800
801 when 'J' =>
802 Warn_On_Obsolescent_Feature := False;
803
804 when 'k' =>
805 Warn_On_Constant := True;
806
807 when 'K' =>
808 Warn_On_Constant := False;
809
810 when 'l' =>
811 Elab_Warnings := True;
812
813 when 'L' =>
814 Elab_Warnings := False;
815
816 when 'm' =>
817 Warn_On_Modified_Unread := True;
818
819 when 'M' =>
820 Warn_On_Modified_Unread := False;
821
822 when 'n' =>
823 Warning_Mode := Normal;
824
825 when 'o' =>
826 Address_Clause_Overlay_Warnings := True;
827
828 when 'O' =>
829 Address_Clause_Overlay_Warnings := False;
830
831 when 'p' =>
832 Ineffective_Inline_Warnings := True;
833
834 when 'P' =>
835 Ineffective_Inline_Warnings := False;
836
837 when 'r' =>
838 Warn_On_Redundant_Constructs := True;
839
840 when 'R' =>
841 Warn_On_Redundant_Constructs := False;
842
843 when 's' =>
844 Warning_Mode := Suppress;
845
846 when 'u' =>
847 Check_Unreferenced := True;
848 Check_Withs := True;
849 Check_Unreferenced_Formals := True;
850
851 when 'U' =>
852 Check_Unreferenced := False;
853 Check_Withs := False;
854 Check_Unreferenced_Formals := False;
855
856 when 'v' =>
857 Warn_On_No_Value_Assigned := True;
858
859 when 'V' =>
860 Warn_On_No_Value_Assigned := False;
861
862 when 'x' =>
863 Warn_On_Export_Import := True;
864
865 when 'X' =>
866 Warn_On_Export_Import := False;
867
868 when 'z' =>
869 Warn_On_Unchecked_Conversion := True;
870
871 when 'Z' =>
872 Warn_On_Unchecked_Conversion := False;
873
874 -- Allow and ignore 'w' so that the old
875 -- format (e.g. -gnatwuwl) will work.
876
877 when 'w' =>
878 null;
879
880 when others =>
881 raise Bad_Switch;
882 end case;
883
884 if C /= 'w' then
885 Storing (First_Stored + 1) := C;
886 Store_Compilation_Switch
887 (Storing (Storing'First .. First_Stored + 1));
888 end if;
889
890 Ptr := Ptr + 1;
891 end loop;
892
893 return;
894
895 -- Processing for W switch
896
897 when 'W' =>
898 Ptr := Ptr + 1;
899
900 if Ptr > Max then
901 raise Bad_Switch;
902 end if;
903
904 for J in WC_Encoding_Method loop
905 if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
906 Wide_Character_Encoding_Method := J;
907 exit;
908
909 elsif J = WC_Encoding_Method'Last then
910 raise Bad_Switch;
911 end if;
912 end loop;
913
914 Upper_Half_Encoding :=
915 Wide_Character_Encoding_Method in
916 WC_Upper_Half_Encoding_Method;
917
918 Ptr := Ptr + 1;
919
920 -- Processing for x switch
921
922 when 'x' =>
923 Ptr := Ptr + 1;
924 Xref_Active := False;
925
926 -- Processing for X switch
927
928 when 'X' =>
929 Ptr := Ptr + 1;
930 Extensions_Allowed := True;
931
932 -- Processing for y switch
933
934 when 'y' =>
935 Ptr := Ptr + 1;
936
937 if Ptr > Max then
938 Set_Default_Style_Check_Options;
939
940 else
941 Store_Switch := False;
942 Storing (First_Stored) := 'y';
943
944 declare
945 OK : Boolean;
946 Last_Stored : Integer;
947
948 begin
949 Set_Style_Check_Options
950 (Switch_Chars (Ptr .. Max), OK, Ptr);
951
952 if not OK then
953 raise Bad_Switch;
954 end if;
955
956 Ptr := First_Char + 1;
957
958 while Ptr <= Max loop
959 Last_Stored := First_Stored + 1;
960 Storing (Last_Stored) := Switch_Chars (Ptr);
961
962 if Switch_Chars (Ptr) = 'M' then
963 loop
964 Ptr := Ptr + 1;
965 exit when Ptr > Max
966 or else Switch_Chars (Ptr) not in '0' .. '9';
967 Last_Stored := Last_Stored + 1;
968 Storing (Last_Stored) := Switch_Chars (Ptr);
969 end loop;
970
971 else
972 Ptr := Ptr + 1;
973 end if;
974
975 Store_Compilation_Switch
976 (Storing (Storing'First .. Last_Stored));
977 end loop;
978 end;
979 end if;
980
981 -- Processing for z switch
982
983 when 'z' =>
984 Ptr := Ptr + 1;
985
986 -- Allowed for compiler only if this is the only
987 -- -z switch, we do not allow multiple occurrences
988
989 if Distribution_Stub_Mode = No_Stubs then
990 case Switch_Chars (Ptr) is
991 when 'r' =>
992 Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
993
994 when 'c' =>
995 Distribution_Stub_Mode := Generate_Caller_Stub_Body;
996
997 when others =>
998 raise Bad_Switch;
999 end case;
1000
1001 Ptr := Ptr + 1;
1002
1003 end if;
1004
1005 -- Processing for Z switch
1006
1007 when 'Z' =>
1008 Ptr := Ptr + 1;
1009 Zero_Cost_Exceptions_Set := True;
1010 Zero_Cost_Exceptions_Val := True;
1011
1012 -- Processing for 83 switch
1013
1014 when '8' =>
1015
1016 if Ptr = Max then
1017 raise Bad_Switch;
1018 end if;
1019
1020 Ptr := Ptr + 1;
1021
1022 if Switch_Chars (Ptr) /= '3' then
1023 raise Bad_Switch;
1024 else
1025 Ptr := Ptr + 1;
1026 Ada_95 := False;
1027 Ada_83 := True;
1028 end if;
1029
1030 -- Ignore extra switch character
1031
1032 when '/' | '-' =>
1033 Ptr := Ptr + 1;
1034
1035 -- Anything else is an error (illegal switch character)
1036
1037 when others =>
1038 raise Bad_Switch;
1039 end case;
1040 end case;
1041
1042 if Store_Switch then
1043 Storing (First_Stored .. First_Stored + Ptr - First_Char - 1) :=
1044 Switch_Chars (First_Char .. Ptr - 1);
1045 Store_Compilation_Switch
1046 (Storing (Storing'First .. First_Stored + Ptr - First_Char - 1));
1047 end if;
1048
1049 First_Switch := False;
1050 end loop;
1051
1052 exception
1053 when Bad_Switch =>
1054 Osint.Fail ("invalid switch: ", (1 => C));
1055
1056 when Bad_Switch_Value =>
1057 Osint.Fail ("numeric value out of range for switch: ", (1 => C));
1058
1059 when Missing_Switch_Value =>
1060 Osint.Fail ("missing numeric value for switch: ", (1 => C));
1061
1062 end Scan_Front_End_Switches;
1063
1064 end Switch.C;