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 --                                                                          --
  10 --          Copyright (C) 2001-2002 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 with Debug;    use Debug;
  29 with Osint;    use Osint;
  30 with Opt;      use Opt;
  31 with Table;
  32
  33 package body Switch.M is
  34
  35    package Normalized_Switches is new Table.Table
  36      (Table_Component_Type => String_Access,
  37       Table_Index_Type     => Integer,
  38       Table_Low_Bound      => 1,
  39       Table_Initial        => 20,
  40       Table_Increment      => 100,
  41       Table_Name           => "Switch.C.Normalized_Switches");
  42    --  This table is used to keep the normalized switches, so that they may be
  43    --  reused for subsequent invocations of Normalize_Compiler_Switches with
  44    --  similar switches.
  45
  46    Initial_Number_Of_Switches : constant := 10;
  47
  48    Global_Switches : Argument_List_Access := null;
  49    --  Used by function Normalize_Compiler_Switches
  50
  51    ---------------------------------
  52    -- Normalize_Compiler_Switches --
  53    ---------------------------------
  54
  55    procedure Normalize_Compiler_Switches
  56      (Switch_Chars : String;
  57       Switches     : in out Argument_List_Access;
  58       Last         : out Natural)
  59    is
  60       Switch_Starts_With_Gnat : Boolean;
  61
  62       Ptr : Integer := Switch_Chars'First;
  63       Max : constant Integer := Switch_Chars'Last;
  64       C   : Character := ' ';
  65
  66       First_Char   : Integer := Ptr;
  67       Storing      : String := Switch_Chars;
  68       First_Stored : Positive := Ptr + 1;
  69       Last_Stored  : Positive := First_Stored;
  70
  71       procedure Add_Switch_Component (S : String);
  72       --  Add a new String_Access component in Switches. If a string equal
  73       --  to S is already stored in the table Normalized_Switches, use it.
  74       --  Other wise add a new component to the table.
  75
  76       --------------------------
  77       -- Add_Switch_Component --
  78       --------------------------
  79
  80       procedure Add_Switch_Component (S : String) is
  81       begin
  82          --  If Switches is null, allocate a new array
  83
  84          if Switches = null then
  85             Switches := new Argument_List (1 .. Initial_Number_Of_Switches);
  86
  87          --  otherwise, if Switches is full, extend it
  88
  89          elsif Last = Switches'Last then
  90             declare
  91                New_Switches : Argument_List_Access := new Argument_List
  92                  (1 .. Switches'Length + Switches'Length);
  93             begin
  94                New_Switches (1 .. Switches'Length) := Switches.all;
  95                Last := Switches'Length;
  96                Switches := New_Switches;
  97             end;
  98          end if;
  99
 100          --  If this is the first switch, Last designates the first component
 101          if Last = 0 then
 102             Last := Switches'First;
 103
 104          else
 105             Last := Last + 1;
 106          end if;
 107
 108          --  Look into the table Normalized_Switches for a similar string.
 109          --  If one is found, put it at the added component, and return.
 110
 111          for Index in 1 .. Normalized_Switches.Last loop
 112             if S = Normalized_Switches.Table (Index).all then
 113                Switches (Last) := Normalized_Switches.Table (Index);
 114                return;
 115             end if;
 116          end loop;
 117
 118          --  No string equal to S was found in the table Normalized_Switches.
 119          --  Add a new component in the table.
 120
 121          Switches (Last) := new String'(S);
 122          Normalized_Switches.Increment_Last;
 123          Normalized_Switches.Table (Normalized_Switches.Last) :=
 124            Switches (Last);
 125       end Add_Switch_Component;
 126
 127    --  Start of processing for Normalize_Compiler_Switches
 128
 129    begin
 130       Last := 0;
 131
 132       if Ptr = Max or else Switch_Chars (Ptr) /= '-' then
 133          return;
 134       end if;
 135
 136       Ptr := Ptr + 1;
 137
 138       Switch_Starts_With_Gnat :=
 139          Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
 140
 141       if Switch_Starts_With_Gnat then
 142          Ptr := Ptr + 4;
 143          First_Stored := Ptr;
 144       end if;
 145
 146       while Ptr <= Max loop
 147          First_Char := Ptr;
 148          C := Switch_Chars (Ptr);
 149
 150          --  Processing for a switch
 151
 152          case Switch_Starts_With_Gnat is
 153
 154             when False =>
 155                --  All switches that don't start with -gnat stay as is
 156
 157                Add_Switch_Component (Switch_Chars);
 158                return;
 159
 160             when True =>
 161
 162                case C is
 163
 164                   --  One-letter switches
 165
 166                   when 'a' | 'A' | 'b' | 'c' | 'C' | 'D' | 'E' | 'f' |
 167                     'F' | 'g' | 'h' | 'H' | 'k' | 'l' | 'L' | 'n' | 'N' |
 168                     'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' |
 169                     'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
 170                      Storing (First_Stored) := C;
 171                      Add_Switch_Component
 172                        (Storing (Storing'First .. First_Stored));
 173                      Ptr := Ptr + 1;
 174
 175                   --  One-letter switches followed by a positive number
 176
 177                   when 'm' | 'T' =>
 178                      Storing (First_Stored) := C;
 179                      Last_Stored := First_Stored;
 180
 181                      loop
 182                         Ptr := Ptr + 1;
 183                         exit when Ptr > Max
 184                           or else Switch_Chars (Ptr) not in '0' .. '9';
 185                         Last_Stored := Last_Stored + 1;
 186                         Storing (Last_Stored) := Switch_Chars (Ptr);
 187                      end loop;
 188
 189                      Add_Switch_Component
 190                        (Storing (Storing'First .. Last_Stored));
 191
 192                   when 'd' =>
 193                      Storing (First_Stored) := 'd';
 194
 195                      while Ptr < Max loop
 196                         Ptr := Ptr + 1;
 197                         C := Switch_Chars (Ptr);
 198                         exit when C = ASCII.NUL or else C = '/'
 199                           or else C = '-';
 200
 201                         if C in '1' .. '9' or else
 202                            C in 'a' .. 'z' or else
 203                            C in 'A' .. 'Z'
 204                         then
 205                            Storing (First_Stored + 1) := C;
 206                            Add_Switch_Component
 207                              (Storing (Storing'First .. First_Stored + 1));
 208
 209                         else
 210                            Last := 0;
 211                            return;
 212                         end if;
 213                      end loop;
 214
 215                      return;
 216
 217                   when 'e' =>
 218                      --  None of the -gnate switches (-gnatec and -gnatem)
 219                      --  need to be store in an ALI file.
 220
 221                      return;
 222
 223                   when 'i' =>
 224                      Storing (First_Stored) := 'i';
 225
 226                      Ptr := Ptr + 1;
 227
 228                      if Ptr > Max then
 229                         Last := 0;
 230                         return;
 231                      end if;
 232
 233                      C := Switch_Chars (Ptr);
 234
 235                      if C in '1' .. '5'
 236                        or else C = '8'
 237                        or else C = 'p'
 238                        or else C = 'f'
 239                        or else C = 'n'
 240                        or else C = 'w'
 241                      then
 242                         Storing (First_Stored + 1) := C;
 243                         Add_Switch_Component
 244                           (Storing (Storing'First .. First_Stored + 1));
 245                         Ptr := Ptr + 1;
 246
 247                      else
 248                         Last := 0;
 249                         return;
 250                      end if;
 251
 252                   --  -gnatR may be followed by '0', '1', '2' or '3',
 253                   --  then by 's'
 254
 255                   when 'R' =>
 256                      Last_Stored := First_Stored;
 257                      Storing (Last_Stored) := 'R';
 258                      Ptr := Ptr + 1;
 259
 260                      if Ptr <= Max
 261                        and then Switch_Chars (Ptr) in '0' .. '9'
 262                      then
 263                         C := Switch_Chars (Ptr);
 264
 265                         if C in '4' .. '9' then
 266                            Last := 0;
 267                            return;
 268
 269                         else
 270                            Last_Stored := Last_Stored + 1;
 271                            Storing (Last_Stored) := C;
 272                            Ptr := Ptr + 1;
 273
 274                            if Ptr <= Max
 275                              and then Switch_Chars (Ptr) = 's' then
 276                               Last_Stored := Last_Stored + 1;
 277                               Storing (Last_Stored) := 's';
 278                               Ptr := Ptr + 1;
 279                            end if;
 280                         end if;
 281                      end if;
 282
 283                      Add_Switch_Component
 284                        (Storing (Storing'First .. Last_Stored));
 285
 286                   --  Multiple switches
 287
 288                   when 'V' | 'w' | 'y' =>
 289                      Storing (First_Stored) := C;
 290                      Ptr := Ptr + 1;
 291
 292                      if Ptr > Max then
 293                         if C = 'y' then
 294                            Add_Switch_Component
 295                              (Storing (Storing'First .. First_Stored));
 296
 297                         else
 298                            Last := 0;
 299                            return;
 300                         end if;
 301                      end if;
 302
 303                      while Ptr <= Max loop
 304                         C := Switch_Chars (Ptr);
 305                         Ptr := Ptr + 1;
 306
 307                         --  'w' should be skipped in -gnatw
 308
 309                         if C /= 'w' or else Storing (First_Stored) /= 'w' then
 310
 311                            --  -gnatyMxxx
 312
 313                            if C = 'M'
 314                              and then Storing (First_Stored) = 'y' then
 315                               Last_Stored := First_Stored + 1;
 316                               Storing (Last_Stored) := 'M';
 317
 318                               while Ptr <= Max loop
 319                                  C := Switch_Chars (Ptr);
 320                                  exit when C not in '0' .. '9';
 321                                  Last_Stored := Last_Stored + 1;
 322                                  Storing (Last_Stored) := C;
 323                                  Ptr := Ptr + 1;
 324                               end loop;
 325
 326                               --  If there is no digit after -gnatyM,
 327                               --  the switch is invalid.
 328
 329                               if Last_Stored = First_Stored + 1 then
 330                                  Last := 0;
 331                                  return;
 332
 333                               else
 334                                  Add_Switch_Component
 335                                    (Storing (Storing'First .. Last_Stored));
 336                               end if;
 337
 338                            --  All other switches are -gnatxx
 339
 340                            else
 341                               Storing (First_Stored + 1) := C;
 342                               Add_Switch_Component
 343                                 (Storing (Storing'First .. First_Stored + 1));
 344                            end if;
 345                         end if;
 346                      end loop;
 347
 348                   --  Not a valid switch
 349
 350                   when others =>
 351                      Last := 0;
 352                      return;
 353
 354                end case;
 355
 356          end case;
 357       end loop;
 358    end Normalize_Compiler_Switches;
 359
 360    function Normalize_Compiler_Switches
 361      (Switch_Chars : String)
 362       return         Argument_List
 363    is
 364       Last : Natural;
 365
 366    begin
 367       Normalize_Compiler_Switches (Switch_Chars, Global_Switches, Last);
 368
 369       if Last = 0 then
 370          return (1 .. 0 => null);
 371
 372       else
 373          return Global_Switches (Global_Switches'First .. Last);
 374       end if;
 375
 376    end Normalize_Compiler_Switches;
 377
 378    ------------------------
 379    -- Scan_Make_Switches --
 380    ------------------------
 381
 382    procedure Scan_Make_Switches (Switch_Chars : String) is
 383       Ptr : Integer := Switch_Chars'First;
 384       Max : Integer := Switch_Chars'Last;
 385       C   : Character := ' ';
 386
 387    begin
 388       --  Skip past the initial character (must be the switch character)
 389
 390       if Ptr = Max then
 391          raise Bad_Switch;
 392
 393       else
 394          Ptr := Ptr + 1;
 395       end if;
 396
 397       --  A little check, "gnat" at the start of a switch is not allowed
 398       --  except for the compiler (where it was already removed)
 399
 400       if Switch_Chars'Length >= Ptr + 3
 401         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
 402       then
 403          Osint.Fail
 404            ("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
 405       end if;
 406
 407       --  Loop to scan through switches given in switch string
 408
 409       while Ptr <= Max loop
 410          C := Switch_Chars (Ptr);
 411
 412          --  Processing for a switch
 413
 414          case C is
 415
 416          when 'a' =>
 417             Ptr := Ptr + 1;
 418             Check_Readonly_Files := True;
 419
 420          --  Processing for b switch
 421
 422          when 'b' =>
 423             Ptr := Ptr + 1;
 424             Bind_Only := True;
 425
 426          --  Processing for c switch
 427
 428          when 'c' =>
 429             Ptr := Ptr + 1;
 430             Compile_Only := True;
 431
 432          --  Processing for C switch
 433
 434          when 'C' =>
 435             Ptr := Ptr + 1;
 436             Create_Mapping_File := True;
 437
 438          --  Processing for d switch
 439
 440          when 'd' =>
 441
 442             --  Note: for the debug switch, the remaining characters in this
 443             --  switch field must all be debug flags, since all valid switch
 444             --  characters are also valid debug characters. This switch is not
 445             --  documented on purpose because it is only used by the
 446             --  implementors.
 447
 448             --  Loop to scan out debug flags
 449
 450             while Ptr < Max loop
 451                Ptr := Ptr + 1;
 452                C := Switch_Chars (Ptr);
 453                exit when C = ASCII.NUL or else C = '/' or else C = '-';
 454
 455                if C in '1' .. '9' or else
 456                   C in 'a' .. 'z' or else
 457                   C in 'A' .. 'Z'
 458                then
 459                   Set_Debug_Flag (C);
 460                else
 461                   raise Bad_Switch;
 462                end if;
 463             end loop;
 464
 465             --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
 466             --  is for backwards compatibility with old versions and usage.
 467
 468             if Debug_Flag_XX then
 469                Zero_Cost_Exceptions_Set := True;
 470                Zero_Cost_Exceptions_Val := True;
 471             end if;
 472
 473             return;
 474
 475          --  Processing for f switch
 476
 477          when 'f' =>
 478             Ptr := Ptr + 1;
 479             Force_Compilations := True;
 480
 481          --  Processing for h switch
 482
 483          when 'h' =>
 484             Ptr := Ptr + 1;
 485             Usage_Requested := True;
 486
 487          --  Processing for i switch
 488
 489          when 'i' =>
 490             Ptr := Ptr + 1;
 491             In_Place_Mode := True;
 492
 493          --  Processing for j switch
 494
 495          when 'j' =>
 496             Ptr := Ptr + 1;
 497
 498             declare
 499                Max_Proc : Pos;
 500             begin
 501                Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc);
 502                Maximum_Processes := Positive (Max_Proc);
 503             end;
 504
 505          --  Processing for k switch
 506
 507          when 'k' =>
 508             Ptr := Ptr + 1;
 509             Keep_Going := True;
 510
 511          --  Processing for l switch
 512
 513          when 'l' =>
 514             Ptr := Ptr + 1;
 515             Link_Only := True;
 516
 517          when 'M' =>
 518             Ptr := Ptr + 1;
 519             List_Dependencies := True;
 520
 521          --  Processing for n switch
 522
 523          when 'n' =>
 524             Ptr := Ptr + 1;
 525             Do_Not_Execute := True;
 526
 527          --  Processing for o switch
 528
 529          when 'o' =>
 530             Ptr := Ptr + 1;
 531
 532             if Output_File_Name_Present then
 533                raise Too_Many_Output_Files;
 534             else
 535                Output_File_Name_Present := True;
 536             end if;
 537
 538          --  Processing for q switch
 539
 540          when 'q' =>
 541             Ptr := Ptr + 1;
 542             Quiet_Output := True;
 543
 544          --  Processing for s switch
 545
 546          when 's' =>
 547             Ptr := Ptr + 1;
 548             Check_Switches := True;
 549
 550          --  Processing for v switch
 551
 552          when 'v' =>
 553             Ptr := Ptr + 1;
 554             Verbose_Mode := True;
 555
 556          --  Processing for z switch
 557
 558          when 'z' =>
 559             Ptr := Ptr + 1;
 560             No_Main_Subprogram := True;
 561
 562          --  Ignore extra switch character
 563
 564          when '/' | '-' =>
 565             Ptr := Ptr + 1;
 566
 567          --  Anything else is an error (illegal switch character)
 568
 569          when others =>
 570             raise Bad_Switch;
 571
 572          end case;
 573       end loop;
 574
 575    exception
 576       when Bad_Switch =>
 577          Osint.Fail ("invalid switch: ", (1 => C));
 578
 579       when Bad_Switch_Value =>
 580          Osint.Fail ("numeric value too big for switch: ", (1 => C));
 581
 582       when Missing_Switch_Value =>
 583          Osint.Fail ("missing numeric value for switch: ", (1 => C));
 584
 585       when Too_Many_Output_Files =>
 586          Osint.Fail ("duplicate -o switch");
 587
 588    end Scan_Make_Switches;
 589
 590 end Switch.M;