Merged trunk at revision 161680 into branch.
[official-gcc.git] / gcc / ada / switch-m.adb
blob11491d3de42eb238a25b355fe0d006b4006469c5
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S W I T C H - M --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2010, 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 with Debug; use Debug;
27 with Makeutl; use Makeutl;
28 with Osint; use Osint;
29 with Opt; use Opt;
30 with Prj; use Prj;
31 with Prj.Ext; use Prj.Ext;
32 with Table;
34 package body Switch.M is
36 package Normalized_Switches is new Table.Table
37 (Table_Component_Type => String_Access,
38 Table_Index_Type => Integer,
39 Table_Low_Bound => 1,
40 Table_Initial => 20,
41 Table_Increment => 100,
42 Table_Name => "Switch.M.Normalized_Switches");
43 -- This table is used to keep the normalized switches, so that they may be
44 -- reused for subsequent invocations of Normalize_Compiler_Switches with
45 -- similar switches.
47 Initial_Number_Of_Switches : constant := 10;
49 Global_Switches : Argument_List_Access := null;
50 -- Used by function Normalize_Compiler_Switches
52 ---------------------------------
53 -- Normalize_Compiler_Switches --
54 ---------------------------------
56 procedure Normalize_Compiler_Switches
57 (Switch_Chars : String;
58 Switches : in out Argument_List_Access;
59 Last : out Natural)
61 Switch_Starts_With_Gnat : Boolean;
63 Ptr : Integer := Switch_Chars'First;
64 Max : constant Integer := Switch_Chars'Last;
65 C : Character := ' ';
67 Storing : String := Switch_Chars;
68 First_Stored : Positive := Ptr + 1;
69 Last_Stored : Positive := First_Stored;
71 procedure Add_Switch_Component (S : String);
72 -- Add a new String_Access component in Switches. If a string equal
73 -- to S is already stored in the table Normalized_Switches, use it.
74 -- Otherwise add a new component to the table.
76 --------------------------
77 -- Add_Switch_Component --
78 --------------------------
80 procedure Add_Switch_Component (S : String) is
81 begin
82 -- If Switches is null, allocate a new array
84 if Switches = null then
85 Switches := new Argument_List (1 .. Initial_Number_Of_Switches);
87 -- Otherwise, if Switches is full, extend it
89 elsif Last = Switches'Last then
90 declare
91 New_Switches : constant Argument_List_Access :=
92 new Argument_List
93 (1 .. Switches'Length + Switches'Length);
94 begin
95 New_Switches (1 .. Switches'Length) := Switches.all;
96 Last := Switches'Length;
97 Switches := New_Switches;
98 end;
99 end if;
101 -- If this is the first switch, Last designates the first component
103 if Last = 0 then
104 Last := Switches'First;
105 else
106 Last := Last + 1;
107 end if;
109 -- Look into the table Normalized_Switches for a similar string.
110 -- If one is found, put it at the added component, and return.
112 for Index in 1 .. Normalized_Switches.Last loop
113 if S = Normalized_Switches.Table (Index).all then
114 Switches (Last) := Normalized_Switches.Table (Index);
115 return;
116 end if;
117 end loop;
119 -- No string equal to S was found in the table Normalized_Switches.
120 -- Add a new component in the table.
122 Switches (Last) := new String'(S);
123 Normalized_Switches.Append (Switches (Last));
124 end Add_Switch_Component;
126 -- Start of processing for Normalize_Compiler_Switches
128 begin
129 Last := 0;
131 if Ptr = Max or else Switch_Chars (Ptr) /= '-' then
132 return;
133 end if;
135 Ptr := Ptr + 1;
137 Switch_Starts_With_Gnat :=
138 Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
140 if Switch_Starts_With_Gnat then
141 Ptr := Ptr + 4;
142 First_Stored := Ptr;
143 end if;
145 while Ptr <= Max loop
146 C := Switch_Chars (Ptr);
148 -- Processing for a switch
150 case Switch_Starts_With_Gnat is
152 when False =>
154 -- All switches that don't start with -gnat stay as is,
155 -- except -pg, -Wall, -k8, -w
157 if Switch_Chars = "-pg" or else Switch_Chars = "-p" then
159 -- The gcc driver converts -pg to -p, so that is what
160 -- is stored in the ALI file.
162 Add_Switch_Component ("-p");
164 elsif Switch_Chars = "-Wall" then
166 -- The gcc driver adds -gnatwa when -Wall is used
168 Add_Switch_Component ("-gnatwa");
169 Add_Switch_Component ("-Wall");
171 elsif Switch_Chars = "-k8" then
173 -- The gcc driver transforms -k8 into -gnatk8
175 Add_Switch_Component ("-gnatk8");
177 elsif Switch_Chars = "-w" then
179 -- The gcc driver adds -gnatws when -w is used
181 Add_Switch_Component ("-gnatws");
182 Add_Switch_Component ("-w");
184 elsif Switch_Chars'Length > 6
185 and then
186 Switch_Chars (Switch_Chars'First .. Switch_Chars'First + 5)
187 = "--RTS="
188 then
189 Add_Switch_Component (Switch_Chars);
191 -- When --RTS=mtp is used, the gcc driver adds -mrtp
193 if Switch_Chars = "--RTS=mtp" then
194 Add_Switch_Component ("-mrtp");
195 end if;
197 -- Take only into account switches that are transmitted to
198 -- gnat1 by the gcc driver and stored by gnat1 in the ALI file.
200 else
201 case C is
202 when 'O' | 'W' | 'w' | 'f' | 'd' | 'g' | 'm' =>
203 Add_Switch_Component (Switch_Chars);
205 when others =>
206 null;
207 end case;
208 end if;
210 return;
212 when True =>
214 case C is
216 -- One-letter switches
218 when 'a' | 'A' | 'b' | 'B' | 'c' | 'C' | 'E' | 'f' |
219 'F' | 'g' | 'h' | 'H' | 'I' | 'L' | 'n' | 'N' |
220 'o' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 'S' |
221 't' | 'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
222 Storing (First_Stored) := C;
223 Add_Switch_Component
224 (Storing (Storing'First .. First_Stored));
225 Ptr := Ptr + 1;
227 -- One-letter switches followed by a positive number
229 when 'D' | 'G' | 'j' | 'k' | 'm' | 'T' =>
230 Storing (First_Stored) := C;
231 Last_Stored := First_Stored;
233 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
234 Ptr := Ptr + 1;
235 end if;
237 loop
238 Ptr := Ptr + 1;
239 exit when Ptr > Max
240 or else Switch_Chars (Ptr) not in '0' .. '9';
241 Last_Stored := Last_Stored + 1;
242 Storing (Last_Stored) := Switch_Chars (Ptr);
243 end loop;
245 Add_Switch_Component
246 (Storing (Storing'First .. Last_Stored));
248 when 'd' =>
249 Storing (First_Stored) := 'd';
251 while Ptr < Max loop
252 Ptr := Ptr + 1;
253 C := Switch_Chars (Ptr);
254 exit when C = ASCII.NUL or else C = '/'
255 or else C = '-';
257 if C in '1' .. '9' or else
258 C in 'a' .. 'z' or else
259 C in 'A' .. 'Z'
260 then
261 Storing (First_Stored + 1) := C;
262 Add_Switch_Component
263 (Storing (Storing'First .. First_Stored + 1));
265 else
266 Last := 0;
267 return;
268 end if;
269 end loop;
271 return;
273 when 'e' =>
275 -- Some of the gnate... switches are not stored
277 Storing (First_Stored) := 'e';
278 Ptr := Ptr + 1;
280 if Ptr > Max then
281 Last := 0;
282 return;
284 else
285 case Switch_Chars (Ptr) is
287 when 'D' =>
288 Storing (First_Stored + 1 ..
289 First_Stored + Max - Ptr + 1) :=
290 Switch_Chars (Ptr .. Max);
291 Add_Switch_Component
292 (Storing (Storing'First ..
293 First_Stored + Max - Ptr + 1));
294 Ptr := Max + 1;
296 when 'G' =>
297 Ptr := Ptr + 1;
298 Add_Switch_Component ("-gnateG");
300 when 'I' =>
301 Ptr := Ptr + 1;
303 declare
304 First : constant Positive := Ptr - 1;
305 begin
306 if Ptr <= Max and then
307 Switch_Chars (Ptr) = '='
308 then
309 Ptr := Ptr + 1;
310 end if;
312 while Ptr <= Max and then
313 Switch_Chars (Ptr) in '0' .. '9'
314 loop
315 Ptr := Ptr + 1;
316 end loop;
318 Storing (First_Stored + 1 ..
319 First_Stored + Ptr - First) :=
320 Switch_Chars (First .. Ptr - 1);
321 Add_Switch_Component
322 (Storing (Storing'First ..
323 First_Stored + Ptr - First));
324 end;
326 when 'p' =>
327 Ptr := Ptr + 1;
329 if Ptr = Max then
330 Last := 0;
331 return;
332 end if;
334 if Switch_Chars (Ptr) = '=' then
335 Ptr := Ptr + 1;
336 end if;
338 -- To normalize, always put a '=' after
339 -- -gnatep. Because that could lengthen the
340 -- switch string, declare a local variable.
342 declare
343 To_Store : String (1 .. Max - Ptr + 9);
344 begin
345 To_Store (1 .. 8) := "-gnatep=";
346 To_Store (9 .. Max - Ptr + 9) :=
347 Switch_Chars (Ptr .. Max);
348 Add_Switch_Component (To_Store);
349 end;
351 return;
353 when 'S' =>
354 Ptr := Ptr + 1;
355 Add_Switch_Component ("-gnateS");
357 when others =>
358 Last := 0;
359 return;
360 end case;
361 end if;
363 when 'i' =>
364 Storing (First_Stored) := 'i';
366 Ptr := Ptr + 1;
368 if Ptr > Max then
369 Last := 0;
370 return;
371 end if;
373 C := Switch_Chars (Ptr);
375 if C in '1' .. '5'
376 or else C = '8'
377 or else C = 'p'
378 or else C = 'f'
379 or else C = 'n'
380 or else C = 'w'
381 then
382 Storing (First_Stored + 1) := C;
383 Add_Switch_Component
384 (Storing (Storing'First .. First_Stored + 1));
385 Ptr := Ptr + 1;
387 else
388 Last := 0;
389 return;
390 end if;
392 -- -gnatl may be -gnatl=<file name>
394 when 'l' =>
395 Ptr := Ptr + 1;
397 if Ptr > Max or else Switch_Chars (Ptr) /= '=' then
398 Add_Switch_Component ("-gnatl");
400 else
401 Add_Switch_Component
402 ("-gnatl" & Switch_Chars (Ptr .. Max));
403 return;
404 end if;
406 -- -gnatR may be followed by '0', '1', '2' or '3',
407 -- then by 's'
409 when 'R' =>
410 Last_Stored := First_Stored;
411 Storing (Last_Stored) := 'R';
412 Ptr := Ptr + 1;
414 if Ptr <= Max
415 and then Switch_Chars (Ptr) in '0' .. '9'
416 then
417 C := Switch_Chars (Ptr);
419 if C in '4' .. '9' then
420 Last := 0;
421 return;
423 else
424 Last_Stored := Last_Stored + 1;
425 Storing (Last_Stored) := C;
426 Ptr := Ptr + 1;
428 if Ptr <= Max
429 and then Switch_Chars (Ptr) = 's'
430 then
431 Last_Stored := Last_Stored + 1;
432 Storing (Last_Stored) := 's';
433 Ptr := Ptr + 1;
434 end if;
435 end if;
436 end if;
438 Add_Switch_Component
439 (Storing (Storing'First .. Last_Stored));
441 -- -gnatWx, x = 'h'. 'u', 's', 'e', '8' or 'b'
443 when 'W' =>
444 Storing (First_Stored) := 'W';
445 Ptr := Ptr + 1;
447 if Ptr <= Max then
448 case Switch_Chars (Ptr) is
449 when 'h' | 'u' | 's' | 'e' | '8' | 'b' =>
450 Storing (First_Stored + 1) := Switch_Chars (Ptr);
451 Add_Switch_Component
452 (Storing (Storing'First .. First_Stored + 1));
453 Ptr := Ptr + 1;
455 when others =>
456 Last := 0;
457 return;
458 end case;
459 end if;
461 -- Multiple switches
463 when 'V' | 'w' | 'y' =>
464 Storing (First_Stored) := C;
465 Ptr := Ptr + 1;
467 if Ptr > Max then
468 if C = 'y' then
469 Add_Switch_Component
470 (Storing (Storing'First .. First_Stored));
472 else
473 Last := 0;
474 return;
475 end if;
476 end if;
478 -- Loop through remaining switch characters in string
480 while Ptr <= Max loop
481 C := Switch_Chars (Ptr);
482 Ptr := Ptr + 1;
484 -- -gnatyMxxx
486 if C = 'M' and then Storing (First_Stored) = 'y' then
487 Last_Stored := First_Stored + 1;
488 Storing (Last_Stored) := 'M';
489 while Ptr <= Max loop
490 C := Switch_Chars (Ptr);
491 exit when C not in '0' .. '9';
492 Last_Stored := Last_Stored + 1;
493 Storing (Last_Stored) := C;
494 Ptr := Ptr + 1;
495 end loop;
497 -- If there is no digit after -gnatyM,
498 -- the switch is invalid.
500 if Last_Stored = First_Stored + 1 then
501 Last := 0;
502 return;
504 else
505 Add_Switch_Component
506 (Storing (Storing'First .. Last_Stored));
507 end if;
509 -- --gnatx.x
511 elsif C = '.' and then Ptr <= Max then
512 Storing (First_Stored + 1) := '.';
513 Storing (First_Stored + 2) := Switch_Chars (Ptr);
514 Ptr := Ptr + 1;
515 Add_Switch_Component
516 (Storing (Storing'First .. First_Stored + 2));
518 -- All other switches are -gnatxx
520 else
521 Storing (First_Stored + 1) := C;
522 Add_Switch_Component
523 (Storing (Storing'First .. First_Stored + 1));
524 end if;
525 end loop;
527 -- -gnat95 -gnat05
529 when '0' | '9' =>
530 Last_Stored := First_Stored;
531 Storing (Last_Stored) := C;
532 Ptr := Ptr + 1;
534 if Ptr /= Max or else Switch_Chars (Ptr) /= '5' then
536 -- Invalid switch
538 Last := 0;
539 return;
541 else
542 Last_Stored := Last_Stored + 1;
543 Storing (Last_Stored) := '5';
544 Add_Switch_Component
545 (Storing (Storing'First .. Last_Stored));
546 Ptr := Ptr + 1;
547 end if;
549 -- -gnat83
551 when '8' =>
552 Last_Stored := First_Stored;
553 Storing (Last_Stored) := '8';
554 Ptr := Ptr + 1;
556 if Ptr /= Max or else Switch_Chars (Ptr) /= '3' then
558 -- Invalid switch
560 Last := 0;
561 return;
563 else
564 Last_Stored := Last_Stored + 1;
565 Storing (Last_Stored) := '3';
566 Add_Switch_Component
567 (Storing (Storing'First .. Last_Stored));
568 Ptr := Ptr + 1;
569 end if;
571 -- Not a valid switch
573 when others =>
574 Last := 0;
575 return;
577 end case;
579 end case;
580 end loop;
581 end Normalize_Compiler_Switches;
583 function Normalize_Compiler_Switches
584 (Switch_Chars : String) return Argument_List
586 Last : Natural;
588 begin
589 Normalize_Compiler_Switches (Switch_Chars, Global_Switches, Last);
591 if Last = 0 then
592 return (1 .. 0 => null);
593 else
594 return Global_Switches (Global_Switches'First .. Last);
595 end if;
596 end Normalize_Compiler_Switches;
598 ------------------------
599 -- Scan_Make_Switches --
600 ------------------------
602 procedure Scan_Make_Switches
603 (Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
604 Switch_Chars : String;
605 Success : out Boolean)
607 Ptr : Integer := Switch_Chars'First;
608 Max : constant Integer := Switch_Chars'Last;
609 C : Character := ' ';
611 begin
612 -- Assume a good switch
614 Success := True;
616 -- Skip past the initial character (must be the switch character)
618 if Ptr = Max then
619 Bad_Switch (Switch_Chars);
621 else
622 Ptr := Ptr + 1;
623 end if;
625 -- A little check, "gnat" at the start of a switch is for the compiler
627 if Switch_Chars'Length >= Ptr + 3
628 and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
629 then
630 Success := False;
631 return;
632 end if;
634 C := Switch_Chars (Ptr);
636 -- Multiple character switches
638 if Switch_Chars'Length > 2 then
639 if Switch_Chars = "--create-missing-dirs" then
640 Setup_Projects := True;
642 elsif Switch_Chars'Length > Subdirs_Option'Length
643 and then
644 Switch_Chars
645 (Switch_Chars'First ..
646 Switch_Chars'First + Subdirs_Option'Length - 1) =
647 Subdirs_Option
648 then
649 Subdirs :=
650 new String'
651 (Switch_Chars
652 (Switch_Chars'First + Subdirs_Option'Length ..
653 Switch_Chars'Last));
655 elsif Switch_Chars = Makeutl.Unchecked_Shared_Lib_Imports then
656 Opt.Unchecked_Shared_Lib_Imports := True;
658 elsif Switch_Chars (Ptr) = '-' then
659 Bad_Switch (Switch_Chars);
661 elsif Switch_Chars'Length > 3
662 and then Switch_Chars (Ptr .. Ptr + 1) = "aP"
663 then
664 Add_Search_Project_Directory
665 (Project_Node_Tree,
666 Switch_Chars (Ptr + 2 .. Switch_Chars'Last));
668 elsif C = 'v' and then Switch_Chars'Length = 3 then
669 Ptr := Ptr + 1;
670 Verbose_Mode := True;
672 case Switch_Chars (Ptr) is
673 when 'l' =>
674 Verbosity_Level := Opt.Low;
676 when 'm' =>
677 Verbosity_Level := Opt.Medium;
679 when 'h' =>
680 Verbosity_Level := Opt.High;
682 when others =>
683 Success := False;
684 end case;
686 elsif C = 'd' then
688 -- Note: for the debug switch, the remaining characters in this
689 -- switch field must all be debug flags, since all valid switch
690 -- characters are also valid debug characters. This switch is not
691 -- documented on purpose because it is only used by the
692 -- implementors.
694 -- Loop to scan out debug flags
696 while Ptr < Max loop
697 Ptr := Ptr + 1;
698 C := Switch_Chars (Ptr);
700 if C in 'a' .. 'z' or else C in 'A' .. 'Z' then
701 Set_Debug_Flag (C);
702 else
703 Bad_Switch (Switch_Chars);
704 end if;
705 end loop;
707 elsif C = 'e' then
708 Ptr := Ptr + 1;
710 case Switch_Chars (Ptr) is
712 -- Processing for eI switch
714 when 'I' =>
715 Ptr := Ptr + 1;
716 Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C);
718 if Ptr <= Max then
719 Bad_Switch (Switch_Chars);
720 end if;
722 -- Processing for eL switch
724 when 'L' =>
725 if Ptr /= Max then
726 Bad_Switch (Switch_Chars);
728 else
729 Follow_Links_For_Files := True;
730 Follow_Links_For_Dirs := True;
731 end if;
733 -- Processing for eS switch
735 when 'S' =>
736 if Ptr /= Max then
737 Bad_Switch (Switch_Chars);
739 else
740 Commands_To_Stdout := True;
741 end if;
743 when others =>
744 Bad_Switch (Switch_Chars);
745 end case;
747 elsif C = 'j' then
748 Ptr := Ptr + 1;
750 declare
751 Max_Proc : Pos;
752 begin
753 Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C);
755 if Ptr <= Max then
756 Bad_Switch (Switch_Chars);
758 else
759 Maximum_Processes := Positive (Max_Proc);
760 end if;
761 end;
763 elsif C = 'w' and then Switch_Chars'Length = 3 then
764 Ptr := Ptr + 1;
766 if Switch_Chars = "-we" then
767 Warning_Mode := Treat_As_Error;
769 elsif Switch_Chars = "-wn" then
770 Warning_Mode := Normal;
772 elsif Switch_Chars = "-ws" then
773 Warning_Mode := Suppress;
775 else
776 Success := False;
777 end if;
779 else
780 Success := False;
781 end if;
783 -- Single-character switches
785 else
786 Check_Switch : begin
788 case C is
790 when 'a' =>
791 Check_Readonly_Files := True;
793 -- Processing for b switch
795 when 'b' =>
796 Bind_Only := True;
797 Make_Steps := True;
799 -- Processing for B switch
801 when 'B' =>
802 Build_Bind_And_Link_Full_Project := True;
804 -- Processing for c switch
806 when 'c' =>
807 Compile_Only := True;
808 Make_Steps := True;
810 -- Processing for C switch
812 when 'C' =>
813 Create_Mapping_File := True;
815 -- Processing for D switch
817 when 'D' =>
818 if Object_Directory_Present then
819 Osint.Fail ("duplicate -D switch");
821 else
822 Object_Directory_Present := True;
823 end if;
825 -- Processing for f switch
827 when 'f' =>
828 Force_Compilations := True;
830 -- Processing for F switch
832 when 'F' =>
833 Full_Path_Name_For_Brief_Errors := True;
835 -- Processing for h switch
837 when 'h' =>
838 Usage_Requested := True;
840 -- Processing for i switch
842 when 'i' =>
843 In_Place_Mode := True;
845 -- Processing for j switch
847 when 'j' =>
848 -- -j not followed by a number is an error
850 Bad_Switch (Switch_Chars);
852 -- Processing for k switch
854 when 'k' =>
855 Keep_Going := True;
857 -- Processing for l switch
859 when 'l' =>
860 Link_Only := True;
861 Make_Steps := True;
863 -- Processing for M switch
865 when 'M' =>
866 List_Dependencies := True;
868 -- Processing for n switch
870 when 'n' =>
871 Do_Not_Execute := True;
873 -- Processing for o switch
875 when 'o' =>
876 if Output_File_Name_Present then
877 Osint.Fail ("duplicate -o switch");
878 else
879 Output_File_Name_Present := True;
880 end if;
882 -- Processing for p switch
884 when 'p' =>
885 Setup_Projects := True;
887 -- Processing for q switch
889 when 'q' =>
890 Quiet_Output := True;
892 -- Processing for R switch
894 when 'R' =>
895 Run_Path_Option := False;
897 -- Processing for s switch
899 when 's' =>
900 Ptr := Ptr + 1;
901 Check_Switches := True;
903 -- Processing for v switch
905 when 'v' =>
906 Verbose_Mode := True;
907 Verbosity_Level := Opt.High;
909 -- Processing for x switch
911 when 'x' =>
912 External_Unit_Compilation_Allowed := True;
913 Use_Include_Path_File := True;
915 -- Processing for z switch
917 when 'z' =>
918 No_Main_Subprogram := True;
920 -- Any other small letter is an illegal switch
922 when others =>
923 if C in 'a' .. 'z' then
924 Bad_Switch (Switch_Chars);
926 else
927 Success := False;
928 end if;
930 end case;
931 end Check_Switch;
932 end if;
933 end Scan_Make_Switches;
935 end Switch.M;