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-2006, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Debug;    use Debug;
  28 with Osint;    use Osint;
  29 with Opt;      use Opt;
  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.Increment_Last;
 122          Normalized_Switches.Table (Normalized_Switches.Last) :=
 123            Switches (Last);
 124       end Add_Switch_Component;
 125
 126    --  Start of processing for Normalize_Compiler_Switches
 127
 128    begin
 129       Last := 0;
 130
 131       if Ptr = Max or else Switch_Chars (Ptr) /= '-' then
 132          return;
 133       end if;
 134
 135       Ptr := Ptr + 1;
 136
 137       Switch_Starts_With_Gnat :=
 138          Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
 139
 140       if Switch_Starts_With_Gnat then
 141          Ptr := Ptr + 4;
 142          First_Stored := Ptr;
 143       end if;
 144
 145       while Ptr <= Max loop
 146          C := Switch_Chars (Ptr);
 147
 148          --  Processing for a switch
 149
 150          case Switch_Starts_With_Gnat is
 151
 152             when False =>
 153
 154                --  All switches that don't start with -gnat stay as is,
 155                --  except -v and -pg
 156
 157                if Switch_Chars = "-pg" then
 158
 159                   --  The gcc driver converts -pg to -p, so that is what
 160                   --  is stored in the ALI file.
 161
 162                   Add_Switch_Component ("-p");
 163
 164                elsif C /= 'v' then
 165                   Add_Switch_Component (Switch_Chars);
 166                end if;
 167
 168                return;
 169
 170             when True =>
 171
 172                case C is
 173
 174                   --  One-letter switches
 175
 176                   when 'a' | 'A' | 'b' | 'c' | 'D' | 'E' | 'f' |
 177                     'F' | 'g' | 'h' | 'H' | 'k' | 'l' | 'L' | 'n' | 'N' |
 178                     'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' |
 179                     'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
 180                      Storing (First_Stored) := C;
 181                      Add_Switch_Component
 182                        (Storing (Storing'First .. First_Stored));
 183                      Ptr := Ptr + 1;
 184
 185                   --  One-letter switches followed by a positive number
 186
 187                   when 'm' | 'T' =>
 188                      Storing (First_Stored) := C;
 189                      Last_Stored := First_Stored;
 190
 191                      loop
 192                         Ptr := Ptr + 1;
 193                         exit when Ptr > Max
 194                           or else Switch_Chars (Ptr) not in '0' .. '9';
 195                         Last_Stored := Last_Stored + 1;
 196                         Storing (Last_Stored) := Switch_Chars (Ptr);
 197                      end loop;
 198
 199                      Add_Switch_Component
 200                        (Storing (Storing'First .. Last_Stored));
 201
 202                   when 'd' =>
 203                      Storing (First_Stored) := 'd';
 204
 205                      while Ptr < Max loop
 206                         Ptr := Ptr + 1;
 207                         C := Switch_Chars (Ptr);
 208                         exit when C = ASCII.NUL or else C = '/'
 209                           or else C = '-';
 210
 211                         if C in '1' .. '9' or else
 212                            C in 'a' .. 'z' or else
 213                            C in 'A' .. 'Z'
 214                         then
 215                            Storing (First_Stored + 1) := C;
 216                            Add_Switch_Component
 217                              (Storing (Storing'First .. First_Stored + 1));
 218
 219                         else
 220                            Last := 0;
 221                            return;
 222                         end if;
 223                      end loop;
 224
 225                      return;
 226
 227                   when 'e' =>
 228
 229                      --  Only -gnateD and -gnatep= need storing in ALI file
 230
 231                      Storing (First_Stored) := 'e';
 232                      Ptr := Ptr + 1;
 233
 234                      if Ptr > Max
 235                        or else (Switch_Chars (Ptr) /= 'D'
 236                                   and then Switch_Chars (Ptr) /= 'p')
 237                      then
 238                         Last := 0;
 239                         return;
 240                      end if;
 241
 242                      --  Processing for -gnateD
 243
 244                      if Switch_Chars (Ptr) = 'D' then
 245                         Storing (First_Stored + 1 ..
 246                                  First_Stored + Max - Ptr + 1) :=
 247                           Switch_Chars (Ptr .. Max);
 248                         Add_Switch_Component
 249                           (Storing (Storing'First ..
 250                                       First_Stored + Max - Ptr + 1));
 251
 252                      --  Processing for -gnatep=
 253
 254                      else
 255                         Ptr := Ptr + 1;
 256
 257                         if Ptr = Max then
 258                            Last := 0;
 259                            return;
 260                         end if;
 261
 262                         if Switch_Chars (Ptr) = '=' then
 263                            Ptr := Ptr + 1;
 264                         end if;
 265
 266                         --  To normalize, always put a '=' after -gnatep.
 267                         --  Because that could lengthen the switch string,
 268                         --  declare a local variable.
 269
 270                         declare
 271                            To_Store : String (1 .. Max - Ptr + 9);
 272                         begin
 273                            To_Store (1 .. 8) := "-gnatep=";
 274                            To_Store (9 .. Max - Ptr + 9) :=
 275                              Switch_Chars (Ptr .. Max);
 276                            Add_Switch_Component (To_Store);
 277                         end;
 278                      end if;
 279
 280                      return;
 281
 282                   when 'i' =>
 283                      Storing (First_Stored) := 'i';
 284
 285                      Ptr := Ptr + 1;
 286
 287                      if Ptr > Max then
 288                         Last := 0;
 289                         return;
 290                      end if;
 291
 292                      C := Switch_Chars (Ptr);
 293
 294                      if C in '1' .. '5'
 295                        or else C = '8'
 296                        or else C = 'p'
 297                        or else C = 'f'
 298                        or else C = 'n'
 299                        or else C = 'w'
 300                      then
 301                         Storing (First_Stored + 1) := C;
 302                         Add_Switch_Component
 303                           (Storing (Storing'First .. First_Stored + 1));
 304                         Ptr := Ptr + 1;
 305
 306                      else
 307                         Last := 0;
 308                         return;
 309                      end if;
 310
 311                   --  -gnatR may be followed by '0', '1', '2' or '3',
 312                   --  then by 's'
 313
 314                   when 'R' =>
 315                      Last_Stored := First_Stored;
 316                      Storing (Last_Stored) := 'R';
 317                      Ptr := Ptr + 1;
 318
 319                      if Ptr <= Max
 320                        and then Switch_Chars (Ptr) in '0' .. '9'
 321                      then
 322                         C := Switch_Chars (Ptr);
 323
 324                         if C in '4' .. '9' then
 325                            Last := 0;
 326                            return;
 327
 328                         else
 329                            Last_Stored := Last_Stored + 1;
 330                            Storing (Last_Stored) := C;
 331                            Ptr := Ptr + 1;
 332
 333                            if Ptr <= Max
 334                              and then Switch_Chars (Ptr) = 's' then
 335                               Last_Stored := Last_Stored + 1;
 336                               Storing (Last_Stored) := 's';
 337                               Ptr := Ptr + 1;
 338                            end if;
 339                         end if;
 340                      end if;
 341
 342                      Add_Switch_Component
 343                        (Storing (Storing'First .. Last_Stored));
 344
 345                   --  Multiple switches
 346
 347                   when 'V' | 'w' | 'y' =>
 348                      Storing (First_Stored) := C;
 349                      Ptr := Ptr + 1;
 350
 351                      if Ptr > Max then
 352                         if C = 'y' then
 353                            Add_Switch_Component
 354                              (Storing (Storing'First .. First_Stored));
 355
 356                         else
 357                            Last := 0;
 358                            return;
 359                         end if;
 360                      end if;
 361
 362                      while Ptr <= Max loop
 363                         C := Switch_Chars (Ptr);
 364                         Ptr := Ptr + 1;
 365
 366                         --  'w' should be skipped in -gnatw
 367
 368                         if C /= 'w' or else Storing (First_Stored) /= 'w' then
 369
 370                            --  -gnatyMxxx
 371
 372                            if C = 'M'
 373                              and then Storing (First_Stored) = 'y' then
 374                               Last_Stored := First_Stored + 1;
 375                               Storing (Last_Stored) := 'M';
 376
 377                               while Ptr <= Max loop
 378                                  C := Switch_Chars (Ptr);
 379                                  exit when C not in '0' .. '9';
 380                                  Last_Stored := Last_Stored + 1;
 381                                  Storing (Last_Stored) := C;
 382                                  Ptr := Ptr + 1;
 383                               end loop;
 384
 385                               --  If there is no digit after -gnatyM,
 386                               --  the switch is invalid.
 387
 388                               if Last_Stored = First_Stored + 1 then
 389                                  Last := 0;
 390                                  return;
 391
 392                               else
 393                                  Add_Switch_Component
 394                                    (Storing (Storing'First .. Last_Stored));
 395                               end if;
 396
 397                            --  All other switches are -gnatxx
 398
 399                            else
 400                               Storing (First_Stored + 1) := C;
 401                               Add_Switch_Component
 402                                 (Storing (Storing'First .. First_Stored + 1));
 403                            end if;
 404                         end if;
 405                      end loop;
 406
 407                   --  -gnat95 -gnat05
 408
 409                   when '0' | '9' =>
 410                      Last_Stored := First_Stored;
 411                      Storing (Last_Stored) := C;
 412                      Ptr := Ptr + 1;
 413
 414                      if Ptr /= Max or else Switch_Chars (Ptr) /= '5' then
 415
 416                         --  Invalid switch
 417
 418                         Last := 0;
 419                         return;
 420
 421                      else
 422                         Last_Stored := Last_Stored + 1;
 423                         Storing (Last_Stored) := '5';
 424                         Add_Switch_Component
 425                           (Storing (Storing'First .. Last_Stored));
 426                         Ptr := Ptr + 1;
 427                      end if;
 428
 429                   --  -gnat83
 430
 431                   when '8' =>
 432                      Last_Stored := First_Stored;
 433                      Storing (Last_Stored) := '8';
 434                      Ptr := Ptr + 1;
 435
 436                      if Ptr /= Max or else Switch_Chars (Ptr) /= '3' then
 437
 438                         --  Invalid switch
 439
 440                         Last := 0;
 441                         return;
 442
 443                      else
 444                         Last_Stored := Last_Stored + 1;
 445                         Storing (Last_Stored) := '3';
 446                         Add_Switch_Component
 447                           (Storing (Storing'First .. Last_Stored));
 448                         Ptr := Ptr + 1;
 449                      end if;
 450
 451                   --  Not a valid switch
 452
 453                   when others =>
 454                      Last := 0;
 455                      return;
 456
 457                end case;
 458
 459          end case;
 460       end loop;
 461    end Normalize_Compiler_Switches;
 462
 463    function Normalize_Compiler_Switches
 464      (Switch_Chars : String)
 465       return         Argument_List
 466    is
 467       Last : Natural;
 468
 469    begin
 470       Normalize_Compiler_Switches (Switch_Chars, Global_Switches, Last);
 471
 472       if Last = 0 then
 473          return (1 .. 0 => null);
 474       else
 475          return Global_Switches (Global_Switches'First .. Last);
 476       end if;
 477
 478    end Normalize_Compiler_Switches;
 479
 480    ------------------------
 481    -- Scan_Make_Switches --
 482    ------------------------
 483
 484    procedure Scan_Make_Switches (Switch_Chars : String) is
 485       Ptr : Integer          := Switch_Chars'First;
 486       Max : constant Integer := Switch_Chars'Last;
 487       C   : Character        := ' ';
 488
 489    begin
 490       --  Skip past the initial character (must be the switch character)
 491
 492       if Ptr = Max then
 493          Bad_Switch (Switch_Chars);
 494
 495       else
 496          Ptr := Ptr + 1;
 497       end if;
 498
 499       --  A little check, "gnat" at the start of a switch is not allowed
 500       --  except for the compiler (where it was already removed)
 501
 502       if Switch_Chars'Length >= Ptr + 3
 503         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
 504       then
 505          Osint.Fail
 506            ("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
 507       end if;
 508
 509       --  Loop to scan through switches given in switch string
 510
 511       Check_Switch : begin
 512          C := Switch_Chars (Ptr);
 513
 514          --  Processing for a switch
 515
 516          case C is
 517
 518          when 'a' =>
 519             Ptr := Ptr + 1;
 520             Check_Readonly_Files := True;
 521
 522          --  Processing for b switch
 523
 524          when 'b' =>
 525             Ptr := Ptr + 1;
 526             Bind_Only  := True;
 527             Make_Steps := True;
 528
 529          --  Processing for B switch
 530
 531          when 'B' =>
 532             Ptr := Ptr + 1;
 533             Build_Bind_And_Link_Full_Project := True;
 534
 535          --  Processing for c switch
 536
 537          when 'c' =>
 538             Ptr := Ptr + 1;
 539             Compile_Only := True;
 540             Make_Steps   := True;
 541
 542          --  Processing for C switch
 543
 544          when 'C' =>
 545             Ptr := Ptr + 1;
 546             Create_Mapping_File := True;
 547
 548          --  Processing for D switch
 549
 550          when 'D' =>
 551             Ptr := Ptr + 1;
 552
 553             if Object_Directory_Present then
 554                Osint.Fail ("duplicate -D switch");
 555
 556             else
 557                Object_Directory_Present := True;
 558             end if;
 559
 560          --  Processing for d switch
 561
 562          when 'd' =>
 563
 564             --  Note: for the debug switch, the remaining characters in this
 565             --  switch field must all be debug flags, since all valid switch
 566             --  characters are also valid debug characters. This switch is not
 567             --  documented on purpose because it is only used by the
 568             --  implementors.
 569
 570             --  Loop to scan out debug flags
 571
 572             while Ptr < Max loop
 573                Ptr := Ptr + 1;
 574                C := Switch_Chars (Ptr);
 575
 576                if C in 'a' .. 'z' or else C in 'A' .. 'Z' then
 577                   Set_Debug_Flag (C);
 578                else
 579                   Bad_Switch (Switch_Chars);
 580                end if;
 581             end loop;
 582
 583             return;
 584
 585          --  Processing for e switch
 586
 587          when 'e' =>
 588             Ptr := Ptr + 1;
 589
 590             if Ptr > Max then
 591                Bad_Switch (Switch_Chars);
 592             end if;
 593
 594             case Switch_Chars (Ptr) is
 595
 596                --  Processing for eI switch
 597
 598                when 'I' =>
 599                   Ptr := Ptr + 1;
 600                   Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C);
 601
 602                --  Processing for eL switch
 603
 604                when 'L' =>
 605                   Ptr := Ptr + 1;
 606                   Follow_Links := True;
 607
 608                when others =>
 609                   Bad_Switch (Switch_Chars);
 610             end case;
 611
 612          --  Processing for f switch
 613
 614          when 'f' =>
 615             Ptr := Ptr + 1;
 616             Force_Compilations := True;
 617
 618          --  Processing for F switch
 619
 620          when 'F' =>
 621             Ptr := Ptr + 1;
 622             Full_Path_Name_For_Brief_Errors := True;
 623
 624          --  Processing for h switch
 625
 626          when 'h' =>
 627             Ptr := Ptr + 1;
 628             Usage_Requested := True;
 629
 630          --  Processing for i switch
 631
 632          when 'i' =>
 633             Ptr := Ptr + 1;
 634             In_Place_Mode := True;
 635
 636          --  Processing for j switch
 637
 638          when 'j' =>
 639             if Ptr = Max then
 640                Bad_Switch (Switch_Chars);
 641             end if;
 642
 643             Ptr := Ptr + 1;
 644
 645             declare
 646                Max_Proc : Pos;
 647             begin
 648                Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C);
 649                Maximum_Processes := Positive (Max_Proc);
 650             end;
 651
 652          --  Processing for k switch
 653
 654          when 'k' =>
 655             Ptr := Ptr + 1;
 656             Keep_Going := True;
 657
 658          --  Processing for l switch
 659
 660          when 'l' =>
 661             Ptr := Ptr + 1;
 662             Link_Only  := True;
 663             Make_Steps := True;
 664
 665          when 'M' =>
 666             Ptr := Ptr + 1;
 667             List_Dependencies := True;
 668
 669          --  Processing for n switch
 670
 671          when 'n' =>
 672             Ptr := Ptr + 1;
 673             Do_Not_Execute := True;
 674
 675          --  Processing for o switch
 676
 677          when 'o' =>
 678             Ptr := Ptr + 1;
 679
 680             if Output_File_Name_Present then
 681                Osint.Fail ("duplicate -o switch");
 682             else
 683                Output_File_Name_Present := True;
 684             end if;
 685
 686          --  Processing for q switch
 687
 688          when 'q' =>
 689             Ptr := Ptr + 1;
 690             Quiet_Output := True;
 691
 692          --  Processing for R switch
 693
 694          when 'R' =>
 695             Ptr := Ptr + 1;
 696             Run_Path_Option := False;
 697
 698          --  Processing for s switch
 699
 700          when 's' =>
 701             Ptr := Ptr + 1;
 702             Check_Switches := True;
 703
 704          --  Processing for S switch
 705
 706          when 'S' =>
 707             Ptr := Ptr + 1;
 708             Commands_To_Stdout := True;
 709
 710          --  Processing for v switch
 711
 712          when 'v' =>
 713             Ptr := Ptr + 1;
 714             Verbose_Mode := True;
 715             Verbosity_Level := Opt.High;
 716
 717             if Ptr <= Max then
 718                case Switch_Chars (Ptr) is
 719                   when 'l' =>
 720                      Verbosity_Level := Opt.Low;
 721
 722                   when 'm' =>
 723                      Verbosity_Level := Opt.Medium;
 724
 725                   when 'h' =>
 726                      Verbosity_Level := Opt.High;
 727
 728                   when others =>
 729                      Bad_Switch (Switch_Chars);
 730                end case;
 731
 732                Ptr := Ptr + 1;
 733             end if;
 734
 735          --  Processing for x switch
 736
 737          when 'x' =>
 738             Ptr := Ptr + 1;
 739             External_Unit_Compilation_Allowed := True;
 740
 741          --  Processing for z switch
 742
 743          when 'z' =>
 744             Ptr := Ptr + 1;
 745             No_Main_Subprogram := True;
 746
 747          --  Anything else is an error (illegal switch character)
 748
 749          when others =>
 750             Bad_Switch (Switch_Chars);
 751
 752          end case;
 753
 754          if Ptr <= Max then
 755             Bad_Switch (Switch_Chars);
 756          end if;
 757
 758       end Check_Switch;
 759
 760    end Scan_Make_Switches;
 761
 762 end Switch.M;