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-2005 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
 475       else
 476          return Global_Switches (Global_Switches'First .. Last);
 477       end if;
 478
 479    end Normalize_Compiler_Switches;
 480
 481    ------------------------
 482    -- Scan_Make_Switches --
 483    ------------------------
 484
 485    procedure Scan_Make_Switches (Switch_Chars : String) is
 486       Ptr : Integer          := Switch_Chars'First;
 487       Max : constant Integer := Switch_Chars'Last;
 488       C   : Character        := ' ';
 489
 490    begin
 491       --  Skip past the initial character (must be the switch character)
 492
 493       if Ptr = Max then
 494          raise Bad_Switch;
 495
 496       else
 497          Ptr := Ptr + 1;
 498       end if;
 499
 500       --  A little check, "gnat" at the start of a switch is not allowed
 501       --  except for the compiler (where it was already removed)
 502
 503       if Switch_Chars'Length >= Ptr + 3
 504         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
 505       then
 506          Osint.Fail
 507            ("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
 508       end if;
 509
 510       --  Loop to scan through switches given in switch string
 511
 512       Check_Switch : begin
 513          C := Switch_Chars (Ptr);
 514
 515          --  Processing for a switch
 516
 517          case C is
 518
 519          when 'a' =>
 520             Ptr := Ptr + 1;
 521             Check_Readonly_Files := True;
 522
 523          --  Processing for b switch
 524
 525          when 'b' =>
 526             Ptr := Ptr + 1;
 527             Bind_Only  := True;
 528             Make_Steps := True;
 529
 530          --  Processing for B switch
 531
 532          when 'B' =>
 533             Ptr := Ptr + 1;
 534             Build_Bind_And_Link_Full_Project := True;
 535
 536          --  Processing for c switch
 537
 538          when 'c' =>
 539             Ptr := Ptr + 1;
 540             Compile_Only := True;
 541             Make_Steps   := True;
 542
 543          --  Processing for C switch
 544
 545          when 'C' =>
 546             Ptr := Ptr + 1;
 547             Create_Mapping_File := True;
 548
 549          --  Processing for D switch
 550
 551          when 'D' =>
 552             Ptr := Ptr + 1;
 553
 554             if Object_Directory_Present then
 555                Osint.Fail ("duplicate -D switch");
 556
 557             else
 558                Object_Directory_Present := True;
 559             end if;
 560
 561          --  Processing for d switch
 562
 563          when 'd' =>
 564
 565             --  Note: for the debug switch, the remaining characters in this
 566             --  switch field must all be debug flags, since all valid switch
 567             --  characters are also valid debug characters. This switch is not
 568             --  documented on purpose because it is only used by the
 569             --  implementors.
 570
 571             --  Loop to scan out debug flags
 572
 573             while Ptr < Max loop
 574                Ptr := Ptr + 1;
 575                C := Switch_Chars (Ptr);
 576                exit when C = ASCII.NUL or else C = '/' or else C = '-';
 577
 578                if C in '1' .. '9' or else
 579                   C in 'a' .. 'z' or else
 580                   C in 'A' .. 'Z'
 581                then
 582                   Set_Debug_Flag (C);
 583                else
 584                   raise Bad_Switch;
 585                end if;
 586             end loop;
 587
 588             --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
 589             --  is for backwards compatibility with old versions and usage.
 590
 591             if Debug_Flag_XX then
 592                Zero_Cost_Exceptions_Set := True;
 593                Zero_Cost_Exceptions_Val := True;
 594             end if;
 595
 596             return;
 597
 598          --  Processing for e switch
 599
 600          when 'e' =>
 601             Ptr := Ptr + 1;
 602
 603             if Ptr > Max then
 604                raise Bad_Switch;
 605             end if;
 606
 607             case Switch_Chars (Ptr) is
 608
 609                --  processing for eI switch
 610
 611                when 'I' =>
 612                   Ptr := Ptr + 1;
 613                   Scan_Pos (Switch_Chars, Max, Ptr, Main_Index);
 614
 615                --  processing for eL switch
 616
 617                when 'L' =>
 618                   Ptr := Ptr + 1;
 619                   Follow_Links := True;
 620
 621                when others =>
 622                   raise Bad_Switch;
 623             end case;
 624
 625          --  Processing for f switch
 626
 627          when 'f' =>
 628             Ptr := Ptr + 1;
 629             Force_Compilations := True;
 630
 631          --  Processing for F switch
 632
 633          when 'F' =>
 634             Ptr := Ptr + 1;
 635             Full_Path_Name_For_Brief_Errors := True;
 636
 637          --  Processing for h switch
 638
 639          when 'h' =>
 640             Ptr := Ptr + 1;
 641             Usage_Requested := True;
 642
 643          --  Processing for i switch
 644
 645          when 'i' =>
 646             Ptr := Ptr + 1;
 647             In_Place_Mode := True;
 648
 649          --  Processing for j switch
 650
 651          when 'j' =>
 652             Ptr := Ptr + 1;
 653
 654             declare
 655                Max_Proc : Pos;
 656             begin
 657                Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc);
 658                Maximum_Processes := Positive (Max_Proc);
 659             end;
 660
 661          --  Processing for k switch
 662
 663          when 'k' =>
 664             Ptr := Ptr + 1;
 665             Keep_Going := True;
 666
 667          --  Processing for l switch
 668
 669          when 'l' =>
 670             Ptr := Ptr + 1;
 671             Link_Only  := True;
 672             Make_Steps := True;
 673
 674          when 'M' =>
 675             Ptr := Ptr + 1;
 676             List_Dependencies := True;
 677
 678          --  Processing for n switch
 679
 680          when 'n' =>
 681             Ptr := Ptr + 1;
 682             Do_Not_Execute := True;
 683
 684          --  Processing for o switch
 685
 686          when 'o' =>
 687             Ptr := Ptr + 1;
 688
 689             if Output_File_Name_Present then
 690                raise Too_Many_Output_Files;
 691             else
 692                Output_File_Name_Present := True;
 693             end if;
 694
 695          --  Processing for q switch
 696
 697          when 'q' =>
 698             Ptr := Ptr + 1;
 699             Quiet_Output := True;
 700
 701          --  Processing for R switch
 702
 703          when 'R' =>
 704             Ptr := Ptr + 1;
 705             Run_Path_Option := False;
 706
 707          --  Processing for s switch
 708
 709          when 's' =>
 710             Ptr := Ptr + 1;
 711             Check_Switches := True;
 712
 713          --  Processing for v switch
 714
 715          when 'v' =>
 716             Ptr := Ptr + 1;
 717             Verbose_Mode := True;
 718
 719          --  Processing for x switch
 720
 721          when 'x' =>
 722             Ptr := Ptr + 1;
 723             External_Unit_Compilation_Allowed := True;
 724
 725          --  Processing for z switch
 726
 727          when 'z' =>
 728             Ptr := Ptr + 1;
 729             No_Main_Subprogram := True;
 730
 731          --  Ignore extra switch character
 732
 733          when '/' | '-' =>
 734             Ptr := Ptr + 1;
 735
 736          --  Anything else is an error (illegal switch character)
 737
 738          when others =>
 739             raise Bad_Switch;
 740
 741          end case;
 742
 743          if Ptr <= Max then
 744             Osint.Fail ("invalid switch: ", Switch_Chars);
 745          end if;
 746
 747       end Check_Switch;
 748
 749    exception
 750       when Bad_Switch =>
 751          Osint.Fail ("invalid switch: ", (1 => C));
 752
 753       when Bad_Switch_Value =>
 754          Osint.Fail ("numeric value out of range for switch: ", (1 => C));
 755
 756       when Missing_Switch_Value =>
 757          Osint.Fail ("missing numeric value for switch: ", (1 => C));
 758
 759       when Too_Many_Output_Files =>
 760          Osint.Fail ("duplicate -o switch");
 761
 762    end Scan_Make_Switches;
 763
 764 end Switch.M;