OSDN Git Service

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