OSDN Git Service

2008-08-04 Vincent Celier <celier@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / switch-m.adb
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-2008, 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 with Debug;    use Debug;
27 with Osint;    use Osint;
28 with Opt;      use Opt;
29 with Prj;      use Prj;
30 with Prj.Ext;  use Prj.Ext;
31 with Table;
32
33 package body Switch.M is
34
35    package Normalized_Switches is new Table.Table
36      (Table_Component_Type => String_Access,
37       Table_Index_Type     => Integer,
38       Table_Low_Bound      => 1,
39       Table_Initial        => 20,
40       Table_Increment      => 100,
41       Table_Name           => "Switch.M.Normalized_Switches");
42    --  This table is used to keep the normalized switches, so that they may be
43    --  reused for subsequent invocations of Normalize_Compiler_Switches with
44    --  similar switches.
45
46    Initial_Number_Of_Switches : constant := 10;
47
48    Global_Switches : Argument_List_Access := null;
49    --  Used by function Normalize_Compiler_Switches
50
51    ---------------------------------
52    -- Normalize_Compiler_Switches --
53    ---------------------------------
54
55    procedure Normalize_Compiler_Switches
56      (Switch_Chars : String;
57       Switches     : in out Argument_List_Access;
58       Last         : out Natural)
59    is
60       Switch_Starts_With_Gnat : Boolean;
61
62       Ptr : Integer := Switch_Chars'First;
63       Max : constant Integer := Switch_Chars'Last;
64       C   : Character := ' ';
65
66       Storing      : String := Switch_Chars;
67       First_Stored : Positive := Ptr + 1;
68       Last_Stored  : Positive := First_Stored;
69
70       procedure Add_Switch_Component (S : String);
71       --  Add a new String_Access component in Switches. If a string equal
72       --  to S is already stored in the table Normalized_Switches, use it.
73       --  Other wise add a new component to the table.
74
75       --------------------------
76       -- Add_Switch_Component --
77       --------------------------
78
79       procedure Add_Switch_Component (S : String) is
80       begin
81          --  If Switches is null, allocate a new array
82
83          if Switches = null then
84             Switches := new Argument_List (1 .. Initial_Number_Of_Switches);
85
86          --  otherwise, if Switches is full, extend it
87
88          elsif Last = Switches'Last then
89             declare
90                New_Switches : constant Argument_List_Access :=
91                                 new Argument_List
92                                       (1 .. Switches'Length + Switches'Length);
93             begin
94                New_Switches (1 .. Switches'Length) := Switches.all;
95                Last := Switches'Length;
96                Switches := New_Switches;
97             end;
98          end if;
99
100          --  If this is the first switch, Last designates the first component
101
102          if Last = 0 then
103             Last := Switches'First;
104          else
105             Last := Last + 1;
106          end if;
107
108          --  Look into the table Normalized_Switches for a similar string.
109          --  If one is found, put it at the added component, and return.
110
111          for Index in 1 .. Normalized_Switches.Last loop
112             if S = Normalized_Switches.Table (Index).all then
113                Switches (Last) := Normalized_Switches.Table (Index);
114                return;
115             end if;
116          end loop;
117
118          --  No string equal to S was found in the table Normalized_Switches.
119          --  Add a new component in the table.
120
121          Switches (Last) := new String'(S);
122          Normalized_Switches.Append (Switches (Last));
123       end Add_Switch_Component;
124
125    --  Start of processing for Normalize_Compiler_Switches
126
127    begin
128       Last := 0;
129
130       if Ptr = Max or else Switch_Chars (Ptr) /= '-' then
131          return;
132       end if;
133
134       Ptr := Ptr + 1;
135
136       Switch_Starts_With_Gnat :=
137          Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
138
139       if Switch_Starts_With_Gnat then
140          Ptr := Ptr + 4;
141          First_Stored := Ptr;
142       end if;
143
144       while Ptr <= Max loop
145          C := Switch_Chars (Ptr);
146
147          --  Processing for a switch
148
149          case Switch_Starts_With_Gnat is
150
151             when False =>
152
153                --  All switches that don't start with -gnat stay as is,
154                --  except -pg, -Wall, -k8, -w
155
156                if Switch_Chars = "-pg" or else Switch_Chars = "-p" then
157
158                   --  The gcc driver converts -pg to -p, so that is what
159                   --  is stored in the ALI file.
160
161                   Add_Switch_Component ("-p");
162
163                elsif Switch_Chars = "-Wall" then
164
165                   --  The gcc driver adds -gnatwa when -Wall is used
166
167                   Add_Switch_Component ("-gnatwa");
168                   Add_Switch_Component ("-Wall");
169
170                elsif Switch_Chars = "-k8" then
171
172                   --  The gcc driver transforms -k8 into -gnatk8
173
174                   Add_Switch_Component ("-gnatk8");
175
176                elsif Switch_Chars = "-w" then
177
178                   --  The gcc driver adds -gnatws when -w is used
179
180                   Add_Switch_Component ("-gnatws");
181                   Add_Switch_Component ("-w");
182
183                elsif Switch_Chars'Length > 6
184                  and then
185                    Switch_Chars (Switch_Chars'First .. Switch_Chars'First + 5)
186                                                              = "--RTS="
187                then
188                   Add_Switch_Component (Switch_Chars);
189
190                   --  When --RTS=mtp is used, the gcc driver adds -mrtp
191
192                   if Switch_Chars = "--RTS=mtp" then
193                      Add_Switch_Component ("-mrtp");
194                   end if;
195
196                --  Take only into account switches that are transmitted to
197                --  gnat1 by the gcc driver and stored by gnat1 in the ALI file.
198
199                else
200                   case C is
201                      when 'O' | 'W' | 'w' | 'f' | 'd' | 'g' | 'm' =>
202                         Add_Switch_Component (Switch_Chars);
203
204                      when others =>
205                         null;
206                   end case;
207                end if;
208
209                return;
210
211             when True =>
212
213                case C is
214
215                   --  One-letter switches
216
217                   when 'a' | 'A' | 'b' | 'c' | 'D' | 'E' | 'f' |
218                     'F' | 'g' | 'h' | 'H' | 'k' | 'l' | 'L' | 'n' | 'N' |
219                     'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' |
220                     'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
221                      Storing (First_Stored) := C;
222                      Add_Switch_Component
223                        (Storing (Storing'First .. First_Stored));
224                      Ptr := Ptr + 1;
225
226                   --  One-letter switches followed by a positive number
227
228                   when 'm' | 'T' =>
229                      Storing (First_Stored) := C;
230                      Last_Stored := First_Stored;
231
232                      loop
233                         Ptr := Ptr + 1;
234                         exit when Ptr > Max
235                           or else Switch_Chars (Ptr) not in '0' .. '9';
236                         Last_Stored := Last_Stored + 1;
237                         Storing (Last_Stored) := Switch_Chars (Ptr);
238                      end loop;
239
240                      Add_Switch_Component
241                        (Storing (Storing'First .. Last_Stored));
242
243                   when 'd' =>
244                      Storing (First_Stored) := 'd';
245
246                      while Ptr < Max loop
247                         Ptr := Ptr + 1;
248                         C := Switch_Chars (Ptr);
249                         exit when C = ASCII.NUL or else C = '/'
250                           or else C = '-';
251
252                         if C in '1' .. '9' or else
253                            C in 'a' .. 'z' or else
254                            C in 'A' .. 'Z'
255                         then
256                            Storing (First_Stored + 1) := C;
257                            Add_Switch_Component
258                              (Storing (Storing'First .. First_Stored + 1));
259
260                         else
261                            Last := 0;
262                            return;
263                         end if;
264                      end loop;
265
266                      return;
267
268                   when 'e' =>
269
270                      --  Store -gnateD, -gnatep= and -gnateG in the ALI file.
271                      --  The other -gnate switches do not need to be stored.
272
273                      Storing (First_Stored) := 'e';
274                      Ptr := Ptr + 1;
275
276                      if Ptr > Max
277                        or else (Switch_Chars (Ptr) /= 'D'
278                                  and then Switch_Chars (Ptr) /= 'G'
279                                  and then Switch_Chars (Ptr) /= 'p')
280                      then
281                         Last := 0;
282                         return;
283                      end if;
284
285                      --  Processing for -gnateD
286
287                      if Switch_Chars (Ptr) = 'D' then
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
295                      --  Processing for -gnatep=
296
297                      elsif Switch_Chars (Ptr) = 'p' then
298                         Ptr := Ptr + 1;
299
300                         if Ptr = Max then
301                            Last := 0;
302                            return;
303                         end if;
304
305                         if Switch_Chars (Ptr) = '=' then
306                            Ptr := Ptr + 1;
307                         end if;
308
309                         --  To normalize, always put a '=' after -gnatep.
310                         --  Because that could lengthen the switch string,
311                         --  declare a local variable.
312
313                         declare
314                            To_Store : String (1 .. Max - Ptr + 9);
315                         begin
316                            To_Store (1 .. 8) := "-gnatep=";
317                            To_Store (9 .. Max - Ptr + 9) :=
318                              Switch_Chars (Ptr .. Max);
319                            Add_Switch_Component (To_Store);
320                         end;
321
322                      elsif Switch_Chars (Ptr) = 'G' then
323                         Add_Switch_Component ("-gnateG");
324                      end if;
325
326                      return;
327
328                   when 'i' =>
329                      Storing (First_Stored) := 'i';
330
331                      Ptr := Ptr + 1;
332
333                      if Ptr > Max then
334                         Last := 0;
335                         return;
336                      end if;
337
338                      C := Switch_Chars (Ptr);
339
340                      if C in '1' .. '5'
341                        or else C = '8'
342                        or else C = 'p'
343                        or else C = 'f'
344                        or else C = 'n'
345                        or else C = 'w'
346                      then
347                         Storing (First_Stored + 1) := C;
348                         Add_Switch_Component
349                           (Storing (Storing'First .. First_Stored + 1));
350                         Ptr := Ptr + 1;
351
352                      else
353                         Last := 0;
354                         return;
355                      end if;
356
357                   --  -gnatR may be followed by '0', '1', '2' or '3',
358                   --  then by 's'
359
360                   when 'R' =>
361                      Last_Stored := First_Stored;
362                      Storing (Last_Stored) := 'R';
363                      Ptr := Ptr + 1;
364
365                      if Ptr <= Max
366                        and then Switch_Chars (Ptr) in '0' .. '9'
367                      then
368                         C := Switch_Chars (Ptr);
369
370                         if C in '4' .. '9' then
371                            Last := 0;
372                            return;
373
374                         else
375                            Last_Stored := Last_Stored + 1;
376                            Storing (Last_Stored) := C;
377                            Ptr := Ptr + 1;
378
379                            if Ptr <= Max
380                              and then Switch_Chars (Ptr) = 's'
381                            then
382                               Last_Stored := Last_Stored + 1;
383                               Storing (Last_Stored) := 's';
384                               Ptr := Ptr + 1;
385                            end if;
386                         end if;
387                      end if;
388
389                      Add_Switch_Component
390                        (Storing (Storing'First .. Last_Stored));
391
392                   --  Multiple switches
393
394                   when 'V' | 'w' | 'y' =>
395                      Storing (First_Stored) := C;
396                      Ptr := Ptr + 1;
397
398                      if Ptr > Max then
399                         if C = 'y' then
400                            Add_Switch_Component
401                              (Storing (Storing'First .. First_Stored));
402
403                         else
404                            Last := 0;
405                            return;
406                         end if;
407                      end if;
408
409                      while Ptr <= Max loop
410                         C := Switch_Chars (Ptr);
411                         Ptr := Ptr + 1;
412
413                         --  -gnatyMxxx
414
415                         if C = 'M' and then Storing (First_Stored) = 'y' then
416                            Last_Stored := First_Stored + 1;
417                            Storing (Last_Stored) := 'M';
418                            while Ptr <= Max loop
419                               C := Switch_Chars (Ptr);
420                               exit when C not in '0' .. '9';
421                               Last_Stored := Last_Stored + 1;
422                               Storing (Last_Stored) := C;
423                               Ptr := Ptr + 1;
424                            end loop;
425
426                            --  If there is no digit after -gnatyM,
427                            --  the switch is invalid.
428
429                            if Last_Stored = First_Stored + 1 then
430                               Last := 0;
431                               return;
432
433                            else
434                               Add_Switch_Component
435                                 (Storing (Storing'First .. Last_Stored));
436                            end if;
437
438                            --  All other switches are -gnatxx
439
440                         else
441                            Storing (First_Stored + 1) := C;
442                            Add_Switch_Component
443                              (Storing (Storing'First .. First_Stored + 1));
444                         end if;
445                      end loop;
446
447                   --  -gnat95 -gnat05
448
449                   when '0' | '9' =>
450                      Last_Stored := First_Stored;
451                      Storing (Last_Stored) := C;
452                      Ptr := Ptr + 1;
453
454                      if Ptr /= Max or else Switch_Chars (Ptr) /= '5' then
455
456                         --  Invalid switch
457
458                         Last := 0;
459                         return;
460
461                      else
462                         Last_Stored := Last_Stored + 1;
463                         Storing (Last_Stored) := '5';
464                         Add_Switch_Component
465                           (Storing (Storing'First .. Last_Stored));
466                         Ptr := Ptr + 1;
467                      end if;
468
469                   --  -gnat83
470
471                   when '8' =>
472                      Last_Stored := First_Stored;
473                      Storing (Last_Stored) := '8';
474                      Ptr := Ptr + 1;
475
476                      if Ptr /= Max or else Switch_Chars (Ptr) /= '3' then
477
478                         --  Invalid switch
479
480                         Last := 0;
481                         return;
482
483                      else
484                         Last_Stored := Last_Stored + 1;
485                         Storing (Last_Stored) := '3';
486                         Add_Switch_Component
487                           (Storing (Storing'First .. Last_Stored));
488                         Ptr := Ptr + 1;
489                      end if;
490
491                   --  Not a valid switch
492
493                   when others =>
494                      Last := 0;
495                      return;
496
497                end case;
498
499          end case;
500       end loop;
501    end Normalize_Compiler_Switches;
502
503    function Normalize_Compiler_Switches
504      (Switch_Chars : String)
505       return         Argument_List
506    is
507       Last : Natural;
508
509    begin
510       Normalize_Compiler_Switches (Switch_Chars, Global_Switches, Last);
511
512       if Last = 0 then
513          return (1 .. 0 => null);
514       else
515          return Global_Switches (Global_Switches'First .. Last);
516       end if;
517
518    end Normalize_Compiler_Switches;
519
520    ------------------------
521    -- Scan_Make_Switches --
522    ------------------------
523
524    procedure Scan_Make_Switches
525      (Switch_Chars : String;
526       Success      : out Boolean)
527    is
528       Ptr : Integer          := Switch_Chars'First;
529       Max : constant Integer := Switch_Chars'Last;
530       C   : Character        := ' ';
531
532    begin
533       --  Assume a good switch
534
535       Success := True;
536
537       --  Skip past the initial character (must be the switch character)
538
539       if Ptr = Max then
540          Bad_Switch (Switch_Chars);
541
542       else
543          Ptr := Ptr + 1;
544       end if;
545
546       --  A little check, "gnat" at the start of a switch is for the compiler
547
548       if Switch_Chars'Length >= Ptr + 3
549         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
550       then
551          Success := False;
552          return;
553       end if;
554
555       C := Switch_Chars (Ptr);
556
557       --  Multiple character switches
558
559       if Switch_Chars'Length > 2 then
560          if Switch_Chars = "--create-missing-dirs" then
561             Setup_Projects := True;
562
563          elsif Switch_Chars'Length > Subdirs_Option'Length
564            and then
565              Switch_Chars
566                (Switch_Chars'First ..
567                 Switch_Chars'First + Subdirs_Option'Length - 1) =
568                                                             Subdirs_Option
569          then
570             Subdirs :=
571               new String'
572                 (Switch_Chars
573                   (Switch_Chars'First + Subdirs_Option'Length ..
574                    Switch_Chars'Last));
575
576          elsif Switch_Chars (Ptr) = '-' then
577             Bad_Switch (Switch_Chars);
578
579          elsif Switch_Chars'Length > 3
580            and then Switch_Chars (Ptr .. Ptr + 1) = "aP"
581          then
582             Add_Search_Project_Directory
583               (Switch_Chars (Ptr + 2 .. Switch_Chars'Last));
584
585          elsif C = 'v' and then Switch_Chars'Length = 3 then
586             Ptr := Ptr + 1;
587             Verbose_Mode := True;
588
589             case Switch_Chars (Ptr) is
590                when 'l' =>
591                   Verbosity_Level := Opt.Low;
592
593                when 'm' =>
594                   Verbosity_Level := Opt.Medium;
595
596                when 'h' =>
597                   Verbosity_Level := Opt.High;
598
599                when others =>
600                   Success := False;
601             end case;
602
603          elsif C = 'd' then
604
605             --  Note: for the debug switch, the remaining characters in this
606             --  switch field must all be debug flags, since all valid switch
607             --  characters are also valid debug characters. This switch is not
608             --  documented on purpose because it is only used by the
609             --  implementors.
610
611             --  Loop to scan out debug flags
612
613             while Ptr < Max loop
614                Ptr := Ptr + 1;
615                C := Switch_Chars (Ptr);
616
617                if C in 'a' .. 'z' or else C in 'A' .. 'Z' then
618                   Set_Debug_Flag (C);
619                else
620                   Bad_Switch (Switch_Chars);
621                end if;
622             end loop;
623
624          elsif C = 'e' then
625             Ptr := Ptr + 1;
626
627             case Switch_Chars (Ptr) is
628
629                --  Processing for eI switch
630
631                when 'I' =>
632                   Ptr := Ptr + 1;
633                   Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C);
634
635                   if Ptr <= Max then
636                      Bad_Switch (Switch_Chars);
637                   end if;
638
639                --  Processing for eL switch
640
641                when 'L' =>
642                   if Ptr /= Max then
643                      Bad_Switch (Switch_Chars);
644
645                   else
646                      Follow_Links_For_Files := True;
647                   end if;
648
649                --  Processing for eS switch
650
651                when 'S' =>
652                   if Ptr /= Max then
653                      Bad_Switch (Switch_Chars);
654
655                   else
656                      Commands_To_Stdout := True;
657                   end if;
658
659                when others =>
660                   Bad_Switch (Switch_Chars);
661             end case;
662
663          elsif C = 'j' then
664             Ptr := Ptr + 1;
665
666             declare
667                Max_Proc : Pos;
668             begin
669                Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C);
670
671                if Ptr <= Max then
672                   Bad_Switch (Switch_Chars);
673
674                else
675                   Maximum_Processes := Positive (Max_Proc);
676                end if;
677             end;
678
679          elsif C = 'w' and then Switch_Chars'Length = 3 then
680             Ptr := Ptr + 1;
681
682             if Switch_Chars = "-we" then
683                Warning_Mode := Treat_As_Error;
684
685             elsif Switch_Chars = "-wn" then
686                Warning_Mode := Normal;
687
688             elsif Switch_Chars = "-ws" then
689                Warning_Mode  := Suppress;
690
691             else
692                Success := False;
693             end if;
694
695          else
696             Success := False;
697          end if;
698
699       --  Single-character switches
700
701       else
702          Check_Switch : begin
703
704             case C is
705
706                when 'a' =>
707                   Check_Readonly_Files := True;
708
709                --  Processing for b switch
710
711                when 'b' =>
712                   Bind_Only  := True;
713                   Make_Steps := True;
714
715                --  Processing for B switch
716
717                when 'B' =>
718                   Build_Bind_And_Link_Full_Project := True;
719
720                --  Processing for c switch
721
722                when 'c' =>
723                   Compile_Only := True;
724                   Make_Steps   := True;
725
726                --  Processing for C switch
727
728                when 'C' =>
729                   Create_Mapping_File := True;
730
731                --  Processing for D switch
732
733                when 'D' =>
734                   if Object_Directory_Present then
735                      Osint.Fail ("duplicate -D switch");
736
737                   else
738                      Object_Directory_Present := True;
739                   end if;
740
741                --  Processing for f switch
742
743                when 'f' =>
744                   Force_Compilations := True;
745
746                --  Processing for F switch
747
748                when 'F' =>
749                   Full_Path_Name_For_Brief_Errors := True;
750
751                --  Processing for h switch
752
753                when 'h' =>
754                   Usage_Requested := True;
755
756                --  Processing for i switch
757
758                when 'i' =>
759                   In_Place_Mode := True;
760
761                --  Processing for j switch
762
763                when 'j' =>
764                   --  -j not followed by a number is an error
765
766                   Bad_Switch (Switch_Chars);
767
768                --  Processing for k switch
769
770                when 'k' =>
771                   Keep_Going := True;
772
773                --  Processing for l switch
774
775                when 'l' =>
776                   Link_Only  := True;
777                   Make_Steps := True;
778
779                --  Processing for M switch
780
781                when 'M' =>
782                   List_Dependencies := True;
783
784                --  Processing for n switch
785
786                when 'n' =>
787                   Do_Not_Execute := True;
788
789                --  Processing for o switch
790
791                when 'o' =>
792                   if Output_File_Name_Present then
793                      Osint.Fail ("duplicate -o switch");
794                   else
795                      Output_File_Name_Present := True;
796                   end if;
797
798                --  Processing for p switch
799
800                when 'p' =>
801                   Setup_Projects := True;
802
803                --  Processing for q switch
804
805                when 'q' =>
806                   Quiet_Output := True;
807
808                --  Processing for R switch
809
810                when 'R' =>
811                   Run_Path_Option := False;
812
813                --  Processing for s switch
814
815                when 's' =>
816                   Ptr := Ptr + 1;
817                   Check_Switches := True;
818
819                --  Processing for v switch
820
821                when 'v' =>
822                   Verbose_Mode := True;
823                   Verbosity_Level := Opt.High;
824
825                   --  Processing for x switch
826
827                when 'x' =>
828                   External_Unit_Compilation_Allowed := True;
829
830                   --  Processing for z switch
831
832                when 'z' =>
833                   No_Main_Subprogram := True;
834
835                   --  Any other small letter is an illegal switch
836
837                when others =>
838                   if C in 'a' .. 'z' then
839                      Bad_Switch (Switch_Chars);
840
841                   else
842                      Success := False;
843                   end if;
844
845             end case;
846          end Check_Switch;
847       end if;
848    end Scan_Make_Switches;
849
850 end Switch.M;