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-2004 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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, 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                   --  Not a valid switch
 408
 409                   when others =>
 410                      Last := 0;
 411                      return;
 412
 413                end case;
 414
 415          end case;
 416       end loop;
 417    end Normalize_Compiler_Switches;
 418
 419    function Normalize_Compiler_Switches
 420      (Switch_Chars : String)
 421       return         Argument_List
 422    is
 423       Last : Natural;
 424
 425    begin
 426       Normalize_Compiler_Switches (Switch_Chars, Global_Switches, Last);
 427
 428       if Last = 0 then
 429          return (1 .. 0 => null);
 430
 431       else
 432          return Global_Switches (Global_Switches'First .. Last);
 433       end if;
 434
 435    end Normalize_Compiler_Switches;
 436
 437    ------------------------
 438    -- Scan_Make_Switches --
 439    ------------------------
 440
 441    procedure Scan_Make_Switches (Switch_Chars : String) is
 442       Ptr : Integer          := Switch_Chars'First;
 443       Max : constant Integer := Switch_Chars'Last;
 444       C   : Character        := ' ';
 445
 446    begin
 447       --  Skip past the initial character (must be the switch character)
 448
 449       if Ptr = Max then
 450          raise Bad_Switch;
 451
 452       else
 453          Ptr := Ptr + 1;
 454       end if;
 455
 456       --  A little check, "gnat" at the start of a switch is not allowed
 457       --  except for the compiler (where it was already removed)
 458
 459       if Switch_Chars'Length >= Ptr + 3
 460         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
 461       then
 462          Osint.Fail
 463            ("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
 464       end if;
 465
 466       --  Loop to scan through switches given in switch string
 467
 468       Check_Switch : begin
 469          C := Switch_Chars (Ptr);
 470
 471          --  Processing for a switch
 472
 473          case C is
 474
 475          when 'a' =>
 476             Ptr := Ptr + 1;
 477             Check_Readonly_Files := True;
 478
 479          --  Processing for b switch
 480
 481          when 'b' =>
 482             Ptr := Ptr + 1;
 483             Bind_Only  := True;
 484             Make_Steps := True;
 485
 486          --  Processing for B switch
 487
 488          when 'B' =>
 489             Ptr := Ptr + 1;
 490             Build_Bind_And_Link_Full_Project := True;
 491
 492          --  Processing for c switch
 493
 494          when 'c' =>
 495             Ptr := Ptr + 1;
 496             Compile_Only := True;
 497             Make_Steps   := True;
 498
 499          --  Processing for C switch
 500
 501          when 'C' =>
 502             Ptr := Ptr + 1;
 503             Create_Mapping_File := True;
 504
 505          --  Processing for D switch
 506
 507          when 'D' =>
 508             Ptr := Ptr + 1;
 509
 510             if Object_Directory_Present then
 511                Osint.Fail ("duplicate -D switch");
 512
 513             else
 514                Object_Directory_Present := True;
 515             end if;
 516
 517          --  Processing for d switch
 518
 519          when 'd' =>
 520
 521             --  Note: for the debug switch, the remaining characters in this
 522             --  switch field must all be debug flags, since all valid switch
 523             --  characters are also valid debug characters. This switch is not
 524             --  documented on purpose because it is only used by the
 525             --  implementors.
 526
 527             --  Loop to scan out debug flags
 528
 529             while Ptr < Max loop
 530                Ptr := Ptr + 1;
 531                C := Switch_Chars (Ptr);
 532                exit when C = ASCII.NUL or else C = '/' or else C = '-';
 533
 534                if C in '1' .. '9' or else
 535                   C in 'a' .. 'z' or else
 536                   C in 'A' .. 'Z'
 537                then
 538                   Set_Debug_Flag (C);
 539                else
 540                   raise Bad_Switch;
 541                end if;
 542             end loop;
 543
 544             --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
 545             --  is for backwards compatibility with old versions and usage.
 546
 547             if Debug_Flag_XX then
 548                Zero_Cost_Exceptions_Set := True;
 549                Zero_Cost_Exceptions_Val := True;
 550             end if;
 551
 552             return;
 553
 554          --  Processing for e switch
 555
 556          when 'e' =>
 557             Ptr := Ptr + 1;
 558
 559             if Ptr > Max then
 560                raise Bad_Switch;
 561             end if;
 562
 563             case Switch_Chars (Ptr) is
 564
 565                --  processing for eI switch
 566
 567                when 'I' =>
 568                   Ptr := Ptr + 1;
 569                   Scan_Pos (Switch_Chars, Max, Ptr, Main_Index);
 570
 571                --  processing for eL switch
 572
 573                when 'L' =>
 574                   Ptr := Ptr + 1;
 575                   Follow_Links := True;
 576
 577                when others =>
 578                   raise Bad_Switch;
 579             end case;
 580
 581          --  Processing for f switch
 582
 583          when 'f' =>
 584             Ptr := Ptr + 1;
 585             Force_Compilations := True;
 586
 587          --  Processing for F switch
 588
 589          when 'F' =>
 590             Ptr := Ptr + 1;
 591             Full_Path_Name_For_Brief_Errors := True;
 592
 593          --  Processing for h switch
 594
 595          when 'h' =>
 596             Ptr := Ptr + 1;
 597             Usage_Requested := True;
 598
 599          --  Processing for i switch
 600
 601          when 'i' =>
 602             Ptr := Ptr + 1;
 603             In_Place_Mode := True;
 604
 605          --  Processing for j switch
 606
 607          when 'j' =>
 608             Ptr := Ptr + 1;
 609
 610             declare
 611                Max_Proc : Pos;
 612             begin
 613                Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc);
 614                Maximum_Processes := Positive (Max_Proc);
 615             end;
 616
 617          --  Processing for k switch
 618
 619          when 'k' =>
 620             Ptr := Ptr + 1;
 621             Keep_Going := True;
 622
 623          --  Processing for l switch
 624
 625          when 'l' =>
 626             Ptr := Ptr + 1;
 627             Link_Only  := True;
 628             Make_Steps := True;
 629
 630          when 'M' =>
 631             Ptr := Ptr + 1;
 632             List_Dependencies := True;
 633
 634          --  Processing for n switch
 635
 636          when 'n' =>
 637             Ptr := Ptr + 1;
 638             Do_Not_Execute := True;
 639
 640          --  Processing for o switch
 641
 642          when 'o' =>
 643             Ptr := Ptr + 1;
 644
 645             if Output_File_Name_Present then
 646                raise Too_Many_Output_Files;
 647             else
 648                Output_File_Name_Present := True;
 649             end if;
 650
 651          --  Processing for q switch
 652
 653          when 'q' =>
 654             Ptr := Ptr + 1;
 655             Quiet_Output := True;
 656
 657          --  Processing for R switch
 658
 659          when 'R' =>
 660             Ptr := Ptr + 1;
 661             Run_Path_Option := False;
 662
 663          --  Processing for s switch
 664
 665          when 's' =>
 666             Ptr := Ptr + 1;
 667             Check_Switches := True;
 668
 669          --  Processing for v switch
 670
 671          when 'v' =>
 672             Ptr := Ptr + 1;
 673             Verbose_Mode := True;
 674
 675          --  Processing for x switch
 676
 677          when 'x' =>
 678             Ptr := Ptr + 1;
 679             External_Unit_Compilation_Allowed := True;
 680
 681          --  Processing for z switch
 682
 683          when 'z' =>
 684             Ptr := Ptr + 1;
 685             No_Main_Subprogram := True;
 686
 687          --  Ignore extra switch character
 688
 689          when '/' | '-' =>
 690             Ptr := Ptr + 1;
 691
 692          --  Anything else is an error (illegal switch character)
 693
 694          when others =>
 695             raise Bad_Switch;
 696
 697          end case;
 698
 699          if Ptr <= Max then
 700             Osint.Fail ("invalid switch: ", Switch_Chars);
 701          end if;
 702
 703       end Check_Switch;
 704
 705    exception
 706       when Bad_Switch =>
 707          Osint.Fail ("invalid switch: ", (1 => C));
 708
 709       when Bad_Switch_Value =>
 710          Osint.Fail ("numeric value out of range for switch: ", (1 => C));
 711
 712       when Missing_Switch_Value =>
 713          Osint.Fail ("missing numeric value for switch: ", (1 => C));
 714
 715       when Too_Many_Output_Files =>
 716          Osint.Fail ("duplicate -o switch");
 717
 718    end Scan_Make_Switches;
 719
 720 end Switch.M;