cselib.c (cselib_current_insn_in_libcall): New static variable.
[official-gcc.git] / gcc / ada / switch-c.adb
blob5502290f00afec175804cff15896199982da5aa7
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S W I T C H - C --
6 -- --
7 -- B o d y --
8 -- --
9 -- --
10 -- Copyright (C) 2001-2002 Free Software Foundation, Inc. --
11 -- --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
22 -- --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 -- --
26 ------------------------------------------------------------------------------
28 with Debug; use Debug;
29 with Lib; use Lib;
30 with Osint; use Osint;
31 with Opt; use Opt;
32 with Types; use Types;
33 with Validsw; use Validsw;
34 with Stylesw; use Stylesw;
36 with System.WCh_Con; use System.WCh_Con;
38 package body Switch.C is
40 -----------------------------
41 -- Scan_Front_End_Switches --
42 -----------------------------
44 procedure Scan_Front_End_Switches (Switch_Chars : String) is
45 Switch_Starts_With_Gnat : Boolean;
46 -- True if first four switch characters are "gnat"
48 First_Switch : Boolean := True;
49 -- False for all but first switch
51 Ptr : Integer := Switch_Chars'First;
52 Max : constant Integer := Switch_Chars'Last;
53 C : Character := ' ';
55 Store_Switch : Boolean := True;
56 First_Char : Integer := Ptr;
57 Storing : String := Switch_Chars;
58 First_Stored : Positive := Ptr + 1;
59 -- The above need comments ???
61 begin
62 -- Skip past the initial character (must be the switch character)
64 if Ptr = Max then
65 raise Bad_Switch;
66 else
67 Ptr := Ptr + 1;
68 end if;
70 -- Remove "gnat" from the switch, if present
72 Switch_Starts_With_Gnat :=
73 Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
75 if Switch_Starts_With_Gnat then
76 Ptr := Ptr + 4;
77 First_Stored := Ptr;
78 end if;
80 -- Loop to scan through switches given in switch string
82 while Ptr <= Max loop
83 Store_Switch := True;
84 First_Char := Ptr;
85 C := Switch_Chars (Ptr);
87 -- Processing for a switch
89 case Switch_Starts_With_Gnat is
91 when False =>
92 -- There are only two front-end switches that
93 -- do not start with -gnat, namely -I and --RTS
95 if Switch_Chars (Ptr) = 'I' then
96 Store_Switch := False;
98 Ptr := Ptr + 1;
100 if Ptr > Max then
101 raise Bad_Switch;
102 end if;
104 -- Find out whether this is a -I- or regular -Ixxx switch
106 if Ptr = Max and then Switch_Chars (Ptr) = '-' then
107 Look_In_Primary_Dir := False;
109 else
110 Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
111 end if;
113 Ptr := Max + 1;
115 -- Processing of the --RTS switch. --RTS has been modified by
116 -- gcc and is now of the form -fRTS
117 elsif Ptr + 3 <= Max and then
118 Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
119 then
120 Ptr := Ptr + 1;
122 if Ptr + 4 > Max or else Switch_Chars (Ptr + 3) /= '=' then
123 Osint.Fail ("missing path for --RTS");
124 else
126 -- valid --RTS switch
127 Opt.No_Stdinc := True;
128 Opt.RTS_Switch := True;
130 declare
131 Src_Path_Name : String_Ptr := Get_RTS_Search_Dir
132 (Switch_Chars (Ptr + 4 .. Max), Include);
133 Lib_Path_Name : String_Ptr := Get_RTS_Search_Dir
134 (Switch_Chars (Ptr + 4 .. Max), Objects);
135 begin
136 if Src_Path_Name /= null and then
137 Lib_Path_Name /= null
138 then
139 Add_Search_Dirs (Src_Path_Name, Include);
140 Add_Search_Dirs (Lib_Path_Name, Objects);
141 Ptr := Max + 1;
142 elsif Src_Path_Name = null
143 and Lib_Path_Name = null then
144 Osint.Fail ("RTS path not valid: missing " &
145 "adainclude and adalib directories");
146 elsif Src_Path_Name = null then
147 Osint.Fail ("RTS path not valid: missing " &
148 "adainclude directory");
149 elsif Lib_Path_Name = null then
150 Osint.Fail ("RTS path not valid: missing " &
151 "adalib directory");
152 end if;
153 end;
154 end if;
155 else
156 raise Bad_Switch;
157 end if;
159 when True =>
160 -- Process -gnat* options
162 case C is
164 when 'a' =>
165 Ptr := Ptr + 1;
166 Assertions_Enabled := True;
168 -- Processing for A switch
170 when 'A' =>
171 Ptr := Ptr + 1;
172 Config_File := False;
174 -- Processing for b switch
176 when 'b' =>
177 Ptr := Ptr + 1;
178 Brief_Output := True;
180 -- Processing for c switch
182 when 'c' =>
183 if not First_Switch then
184 Osint.Fail
185 ("-gnatc myust be first if combined with other switches");
186 end if;
188 Ptr := Ptr + 1;
189 Operating_Mode := Check_Semantics;
191 -- Processing for C switch
193 when 'C' =>
194 Ptr := Ptr + 1;
195 Compress_Debug_Names := True;
197 -- Processing for d switch
199 when 'd' =>
200 Store_Switch := False;
201 Storing (First_Stored) := 'd';
202 -- Note: for the debug switch, the remaining characters in this
203 -- switch field must all be debug flags, since all valid switch
204 -- characters are also valid debug characters.
206 -- Loop to scan out debug flags
208 while Ptr < Max loop
209 Ptr := Ptr + 1;
210 C := Switch_Chars (Ptr);
211 exit when C = ASCII.NUL or else C = '/' or else C = '-';
213 if C in '1' .. '9' or else
214 C in 'a' .. 'z' or else
215 C in 'A' .. 'Z'
216 then
217 Set_Debug_Flag (C);
218 Storing (First_Stored + 1) := C;
219 Store_Compilation_Switch
220 (Storing (Storing'First .. First_Stored + 1));
222 else
223 raise Bad_Switch;
224 end if;
225 end loop;
227 -- Make sure Zero_Cost_Exceptions is set if gnatdX set. This
228 -- is for backwards compatibility with old versions and usage.
230 if Debug_Flag_XX then
231 Zero_Cost_Exceptions_Set := True;
232 Zero_Cost_Exceptions_Val := True;
233 end if;
235 return;
237 -- Processing for D switch
239 when 'D' =>
240 Ptr := Ptr + 1;
242 -- Note: -gnatD also sets -gnatx (to turn off cross-reference
243 -- generation in the ali file) since otherwise this generation
244 -- gets confused by the "wrong" Sloc values put in the tree.
246 Debug_Generated_Code := True;
247 Xref_Active := False;
248 Set_Debug_Flag ('g');
250 -- Processing for e switch
252 when 'e' =>
253 Ptr := Ptr + 1;
255 if Ptr > Max then
256 raise Bad_Switch;
257 end if;
259 case Switch_Chars (Ptr) is
261 -- Configuration pragmas
263 when 'c' =>
264 Store_Switch := False;
265 Ptr := Ptr + 1;
267 if Ptr > Max then
268 raise Bad_Switch;
269 end if;
271 Config_File_Name :=
272 new String'(Switch_Chars (Ptr .. Max));
274 return;
276 -- Mapping file
278 when 'm' =>
279 Store_Switch := False;
280 Ptr := Ptr + 1;
282 if Ptr > Max then
283 raise Bad_Switch;
284 end if;
286 Mapping_File_Name :=
287 new String'(Switch_Chars (Ptr .. Max));
288 return;
290 when others =>
291 raise Bad_Switch;
292 end case;
294 -- Processing for E switch
296 when 'E' =>
297 Ptr := Ptr + 1;
298 Dynamic_Elaboration_Checks := True;
300 -- Processing for f switch
302 when 'f' =>
303 Ptr := Ptr + 1;
304 All_Errors_Mode := True;
306 -- Processing for F switch
308 when 'F' =>
309 Ptr := Ptr + 1;
310 External_Name_Exp_Casing := Uppercase;
311 External_Name_Imp_Casing := Uppercase;
313 -- Processing for g switch
315 when 'g' =>
316 Ptr := Ptr + 1;
317 GNAT_Mode := True;
318 Identifier_Character_Set := 'n';
319 Warning_Mode := Treat_As_Error;
320 Check_Unreferenced := True;
321 Check_Withs := True;
323 Set_Default_Style_Check_Options;
325 -- Processing for G switch
327 when 'G' =>
328 Ptr := Ptr + 1;
329 Print_Generated_Code := True;
331 -- Processing for h switch
333 when 'h' =>
334 Ptr := Ptr + 1;
335 Usage_Requested := True;
337 -- Processing for H switch
339 when 'H' =>
340 Ptr := Ptr + 1;
341 HLO_Active := True;
343 -- Processing for i switch
345 when 'i' =>
346 if Ptr = Max then
347 raise Bad_Switch;
348 end if;
350 Ptr := Ptr + 1;
351 C := Switch_Chars (Ptr);
353 if C in '1' .. '5'
354 or else C = '8'
355 or else C = '9'
356 or else C = 'p'
357 or else C = 'f'
358 or else C = 'n'
359 or else C = 'w'
360 then
361 Identifier_Character_Set := C;
362 Ptr := Ptr + 1;
364 else
365 raise Bad_Switch;
366 end if;
368 -- Processing for k switch
370 when 'k' =>
371 Ptr := Ptr + 1;
372 Scan_Pos (Switch_Chars, Max, Ptr, Maximum_File_Name_Length);
374 -- Processing for l switch
376 when 'l' =>
377 Ptr := Ptr + 1;
378 Full_List := True;
380 -- Processing for L switch
382 when 'L' =>
383 Ptr := Ptr + 1;
384 Zero_Cost_Exceptions_Set := True;
385 Zero_Cost_Exceptions_Val := False;
387 -- Processing for m switch
389 when 'm' =>
390 Ptr := Ptr + 1;
391 Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
393 -- Processing for n switch
395 when 'n' =>
396 Ptr := Ptr + 1;
397 Inline_Active := True;
399 -- Processing for N switch
401 when 'N' =>
402 Ptr := Ptr + 1;
403 Inline_Active := True;
404 Front_End_Inlining := True;
406 -- Processing for o switch
408 when 'o' =>
409 Ptr := Ptr + 1;
410 Suppress_Options.Overflow_Checks := False;
411 Opt.Enable_Overflow_Checks := True;
413 -- Processing for O switch
415 when 'O' =>
416 Ptr := Ptr + 1;
417 Output_File_Name_Present := True;
419 -- Processing for p switch
421 when 'p' =>
422 Ptr := Ptr + 1;
423 Suppress_Options.Access_Checks := True;
424 Suppress_Options.Accessibility_Checks := True;
425 Suppress_Options.Discriminant_Checks := True;
426 Suppress_Options.Division_Checks := True;
427 Suppress_Options.Elaboration_Checks := True;
428 Suppress_Options.Index_Checks := True;
429 Suppress_Options.Length_Checks := True;
430 Suppress_Options.Overflow_Checks := True;
431 Suppress_Options.Range_Checks := True;
432 Suppress_Options.Storage_Checks := True;
433 Suppress_Options.Tag_Checks := True;
435 Validity_Checks_On := False;
436 Opt.Suppress_Checks := True;
437 Opt.Enable_Overflow_Checks := False;
439 -- Processing for P switch
441 when 'P' =>
442 Ptr := Ptr + 1;
443 Polling_Required := True;
445 -- Processing for q switch
447 when 'q' =>
448 Ptr := Ptr + 1;
449 Try_Semantics := True;
451 -- Processing for q switch
453 when 'Q' =>
454 Ptr := Ptr + 1;
455 Force_ALI_Tree_File := True;
456 Try_Semantics := True;
458 -- Processing for R switch
460 when 'R' =>
461 Ptr := Ptr + 1;
462 Back_Annotate_Rep_Info := True;
464 if Ptr <= Max
465 and then Switch_Chars (Ptr) in '0' .. '9'
466 then
467 C := Switch_Chars (Ptr);
469 if C in '4' .. '9' then
470 raise Bad_Switch;
471 else
472 List_Representation_Info :=
473 Character'Pos (C) - Character'Pos ('0');
474 Ptr := Ptr + 1;
475 end if;
477 if Ptr <= Max and then Switch_Chars (Ptr) = 's' then
478 Ptr := Ptr + 1;
480 if List_Representation_Info /= 0 then
481 List_Representation_Info_To_File := True;
482 end if;
483 end if;
485 else
486 List_Representation_Info := 1;
487 end if;
489 -- Processing for s switch
491 when 's' =>
492 if not First_Switch then
493 Osint.Fail
494 ("-gnats myust be first if combined with other switches");
495 end if;
497 Ptr := Ptr + 1;
498 Operating_Mode := Check_Syntax;
500 -- Processing for t switch
502 when 't' =>
503 Ptr := Ptr + 1;
504 Tree_Output := True;
505 Back_Annotate_Rep_Info := True;
507 -- Processing for T switch
509 when 'T' =>
510 Ptr := Ptr + 1;
511 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor);
513 -- Processing for u switch
515 when 'u' =>
516 Ptr := Ptr + 1;
517 List_Units := True;
519 -- Processing for U switch
521 when 'U' =>
522 Ptr := Ptr + 1;
523 Unique_Error_Tag := True;
525 -- Processing for v switch
527 when 'v' =>
528 Ptr := Ptr + 1;
529 Verbose_Mode := True;
531 -- Processing for V switch
533 when 'V' =>
534 Store_Switch := False;
535 Storing (First_Stored) := 'V';
536 Ptr := Ptr + 1;
538 if Ptr > Max then
539 raise Bad_Switch;
541 else
542 declare
543 OK : Boolean;
545 begin
546 Set_Validity_Check_Options
547 (Switch_Chars (Ptr .. Max), OK, Ptr);
549 if not OK then
550 raise Bad_Switch;
551 end if;
553 for Index in First_Char + 1 .. Max loop
554 Storing (First_Stored + 1) :=
555 Switch_Chars (Index);
556 Store_Compilation_Switch
557 (Storing (Storing'First .. First_Stored + 1));
558 end loop;
559 end;
560 end if;
562 Ptr := Max + 1;
564 -- Processing for w switch
566 when 'w' =>
567 Store_Switch := False;
568 Storing (First_Stored) := 'w';
569 Ptr := Ptr + 1;
571 if Ptr > Max then
572 raise Bad_Switch;
573 end if;
575 while Ptr <= Max loop
576 C := Switch_Chars (Ptr);
578 case C is
580 when 'a' =>
581 Constant_Condition_Warnings := True;
582 Elab_Warnings := True;
583 Check_Unreferenced := True;
584 Check_Withs := True;
585 Check_Unreferenced_Formals := True;
586 Implementation_Unit_Warnings := True;
587 Ineffective_Inline_Warnings := True;
588 Warn_On_Redundant_Constructs := True;
590 when 'A' =>
591 Constant_Condition_Warnings := False;
592 Elab_Warnings := False;
593 Check_Unreferenced := False;
594 Check_Withs := False;
595 Check_Unreferenced_Formals := False;
596 Implementation_Unit_Warnings := False;
597 Warn_On_Biased_Rounding := False;
598 Warn_On_Dereference := False;
599 Warn_On_Hiding := False;
600 Warn_On_Redundant_Constructs := False;
601 Ineffective_Inline_Warnings := False;
603 when 'b' =>
604 Warn_On_Biased_Rounding := True;
606 when 'B' =>
607 Warn_On_Biased_Rounding := False;
609 when 'c' =>
610 Constant_Condition_Warnings := True;
612 when 'C' =>
613 Constant_Condition_Warnings := False;
615 when 'd' =>
616 Warn_On_Dereference := True;
618 when 'D' =>
619 Warn_On_Dereference := False;
621 when 'e' =>
622 Warning_Mode := Treat_As_Error;
624 when 'f' =>
625 Check_Unreferenced_Formals := True;
627 when 'F' =>
628 Check_Unreferenced_Formals := False;
630 when 'h' =>
631 Warn_On_Hiding := True;
633 when 'H' =>
634 Warn_On_Hiding := False;
636 when 'i' =>
637 Implementation_Unit_Warnings := True;
639 when 'I' =>
640 Implementation_Unit_Warnings := False;
642 when 'l' =>
643 Elab_Warnings := True;
645 when 'L' =>
646 Elab_Warnings := False;
648 when 'o' =>
649 Address_Clause_Overlay_Warnings := True;
651 when 'O' =>
652 Address_Clause_Overlay_Warnings := False;
654 when 'p' =>
655 Ineffective_Inline_Warnings := True;
657 when 'P' =>
658 Ineffective_Inline_Warnings := False;
660 when 'r' =>
661 Warn_On_Redundant_Constructs := True;
663 when 'R' =>
664 Warn_On_Redundant_Constructs := False;
666 when 's' =>
667 Warning_Mode := Suppress;
669 when 'u' =>
670 Check_Unreferenced := True;
671 Check_Withs := True;
672 Check_Unreferenced_Formals := True;
674 when 'U' =>
675 Check_Unreferenced := False;
676 Check_Withs := False;
677 Check_Unreferenced_Formals := False;
679 -- Allow and ignore 'w' so that the old
680 -- format (e.g. -gnatwuwl) will work.
682 when 'w' =>
683 null;
685 when others =>
686 raise Bad_Switch;
687 end case;
689 if C /= 'w' then
690 Storing (First_Stored + 1) := C;
691 Store_Compilation_Switch
692 (Storing (Storing'First .. First_Stored + 1));
693 end if;
695 Ptr := Ptr + 1;
696 end loop;
698 return;
700 -- Processing for W switch
702 when 'W' =>
703 Ptr := Ptr + 1;
705 if Ptr > Max then
706 raise Bad_Switch;
707 end if;
709 for J in WC_Encoding_Method loop
710 if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
711 Wide_Character_Encoding_Method := J;
712 exit;
714 elsif J = WC_Encoding_Method'Last then
715 raise Bad_Switch;
716 end if;
717 end loop;
719 Upper_Half_Encoding :=
720 Wide_Character_Encoding_Method in
721 WC_Upper_Half_Encoding_Method;
723 Ptr := Ptr + 1;
725 -- Processing for x switch
727 when 'x' =>
728 Ptr := Ptr + 1;
729 Xref_Active := False;
731 -- Processing for X switch
733 when 'X' =>
734 Ptr := Ptr + 1;
735 Extensions_Allowed := True;
737 -- Processing for y switch
739 when 'y' =>
740 Ptr := Ptr + 1;
742 if Ptr > Max then
743 Set_Default_Style_Check_Options;
745 else
746 Store_Switch := False;
747 Storing (First_Stored) := 'y';
749 declare
750 OK : Boolean;
751 Last_Stored : Integer;
753 begin
754 Set_Style_Check_Options
755 (Switch_Chars (Ptr .. Max), OK, Ptr);
757 if not OK then
758 raise Bad_Switch;
759 end if;
761 Ptr := First_Char + 1;
763 while Ptr <= Max loop
764 Last_Stored := First_Stored + 1;
765 Storing (Last_Stored) := Switch_Chars (Ptr);
767 if Switch_Chars (Ptr) = 'M' then
768 loop
769 Ptr := Ptr + 1;
770 exit when Ptr > Max
771 or else Switch_Chars (Ptr) not in '0' .. '9';
772 Last_Stored := Last_Stored + 1;
773 Storing (Last_Stored) := Switch_Chars (Ptr);
774 end loop;
776 else
777 Ptr := Ptr + 1;
778 end if;
780 Store_Compilation_Switch
781 (Storing (Storing'First .. Last_Stored));
782 end loop;
783 end;
784 end if;
786 -- Processing for z switch
788 when 'z' =>
789 Ptr := Ptr + 1;
791 -- Allowed for compiler, only if this is the only
792 -- -z switch, we do not allow multiple occurrences
794 if Distribution_Stub_Mode = No_Stubs then
795 case Switch_Chars (Ptr) is
796 when 'r' =>
797 Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
799 when 'c' =>
800 Distribution_Stub_Mode := Generate_Caller_Stub_Body;
802 when others =>
803 raise Bad_Switch;
804 end case;
806 Ptr := Ptr + 1;
808 end if;
810 -- Processing for Z switch
812 when 'Z' =>
813 Ptr := Ptr + 1;
814 Zero_Cost_Exceptions_Set := True;
815 Zero_Cost_Exceptions_Val := True;
817 -- Processing for 83 switch
819 when '8' =>
821 if Ptr = Max then
822 raise Bad_Switch;
823 end if;
825 Ptr := Ptr + 1;
827 if Switch_Chars (Ptr) /= '3' then
828 raise Bad_Switch;
829 else
830 Ptr := Ptr + 1;
831 Ada_95 := False;
832 Ada_83 := True;
833 end if;
835 -- Ignore extra switch character
837 when '/' | '-' =>
838 Ptr := Ptr + 1;
840 -- Anything else is an error (illegal switch character)
842 when others =>
843 raise Bad_Switch;
844 end case;
845 end case;
847 if Store_Switch then
848 Storing (First_Stored .. First_Stored + Ptr - First_Char - 1) :=
849 Switch_Chars (First_Char .. Ptr - 1);
850 Store_Compilation_Switch
851 (Storing (Storing'First .. First_Stored + Ptr - First_Char - 1));
852 end if;
854 First_Switch := False;
855 end loop;
857 exception
858 when Bad_Switch =>
859 Osint.Fail ("invalid switch: ", (1 => C));
861 when Bad_Switch_Value =>
862 Osint.Fail ("numeric value too big for switch: ", (1 => C));
864 when Missing_Switch_Value =>
865 Osint.Fail ("missing numeric value for switch: ", (1 => C));
867 end Scan_Front_End_Switches;
869 end Switch.C;