gcc/ada/switch-c.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S W I T C H - C                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2013, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 --  This package is for switch processing and should not depend on higher level
  27 --  packages such as those for the scanner, parser, etc. Doing so may cause
  28 --  circularities, especially for back ends using Adabkend.
  29
  30 with Debug;    use Debug;
  31 with Lib;      use Lib;
  32 with Osint;    use Osint;
  33 with Opt;      use Opt;
  34 with Validsw;  use Validsw;
  35 with Stylesw;  use Stylesw;
  36 with Ttypes;   use Ttypes;
  37 with Warnsw;   use Warnsw;
  38
  39 with Ada.Unchecked_Deallocation;
  40 with System.WCh_Con; use System.WCh_Con;
  41
  42 package body Switch.C is
  43
  44    RTS_Specified : String_Access := null;
  45    --  Used to detect multiple use of --RTS= flag
  46
  47    procedure Add_Symbol_Definition (Def : String);
  48    --  Add a symbol definition from the command line
  49
  50    procedure Free is
  51       new Ada.Unchecked_Deallocation (String_List, String_List_Access);
  52    --  Avoid using System.Strings.Free, which also frees the designated strings
  53
  54    function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type;
  55    --  Given a digit in the range 0 .. 3, returns the corresponding value of
  56    --  Overflow_Mode_Type. Raises Program_Error if C is outside this range.
  57
  58    function Switch_Subsequently_Cancelled
  59      (C        : String;
  60       Args     : String_List;
  61       Arg_Rank : Positive) return Boolean;
  62    --  This function is called from Scan_Front_End_Switches. It determines if
  63    --  the switch currently being scanned is followed by a switch of the form
  64    --  "-gnat-" & C, where C is the argument. If so, then True is returned,
  65    --  and Scan_Front_End_Switches will cancel the effect of the switch. If
  66    --  no such switch is found, False is returned.
  67
  68    ---------------------------
  69    -- Add_Symbol_Definition --
  70    ---------------------------
  71
  72    procedure Add_Symbol_Definition (Def : String) is
  73    begin
  74       --  If Preprocessor_Symbol_Defs is not large enough, double its size
  75
  76       if Preprocessing_Symbol_Last = Preprocessing_Symbol_Defs'Last then
  77          declare
  78             New_Symbol_Definitions : constant String_List_Access :=
  79               new String_List (1 .. 2 * Preprocessing_Symbol_Last);
  80          begin
  81             New_Symbol_Definitions (Preprocessing_Symbol_Defs'Range) :=
  82               Preprocessing_Symbol_Defs.all;
  83             Free (Preprocessing_Symbol_Defs);
  84             Preprocessing_Symbol_Defs := New_Symbol_Definitions;
  85          end;
  86       end if;
  87
  88       Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1;
  89       Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last) :=
  90         new String'(Def);
  91    end Add_Symbol_Definition;
  92
  93    -----------------------
  94    -- Get_Overflow_Mode --
  95    -----------------------
  96
  97    function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type is
  98    begin
  99       case C is
 100          when '1' =>
 101             return Strict;
 102
 103          when '2' =>
 104             return Minimized;
 105
 106          --  Eliminated allowed only if Long_Long_Integer is 64 bits (since
 107          --  the current implementation of System.Bignums assumes this).
 108
 109          when '3' =>
 110             if Standard_Long_Long_Integer_Size /= 64 then
 111                Bad_Switch ("-gnato3 not implemented for this configuration");
 112             else
 113                return Eliminated;
 114             end if;
 115
 116          when others =>
 117             raise Program_Error;
 118       end case;
 119    end Get_Overflow_Mode;
 120
 121    -----------------------------
 122    -- Scan_Front_End_Switches --
 123    -----------------------------
 124
 125    procedure Scan_Front_End_Switches
 126      (Switch_Chars : String;
 127       Args         : String_List;
 128       Arg_Rank     : Positive)
 129    is
 130       First_Switch : Boolean := True;
 131       --  False for all but first switch
 132
 133       Max : constant Natural := Switch_Chars'Last;
 134       Ptr : Natural;
 135       C   : Character := ' ';
 136       Dot : Boolean;
 137
 138       Store_Switch : Boolean;
 139       --  For -gnatxx switches, the normal processing, signalled by this flag
 140       --  being set to True, is to store the switch on exit from the case
 141       --  statement, the switch stored is -gnat followed by the characters
 142       --  from First_Char to Ptr-1. For cases like -gnaty, where the switch
 143       --  is stored in separate pieces, this flag is set to False, and the
 144       --  appropriate calls to Store_Compilation_Switch are made from within
 145       --  the case branch.
 146
 147       First_Char : Positive;
 148       --  Marks start of switch to be stored
 149
 150       First_Ptr : Positive;
 151       --  Save position of first character after -gnatd (for checking that
 152       --  debug flags that must come first are first, in particular -gnatd.b),
 153
 154    begin
 155       Ptr := Switch_Chars'First;
 156
 157       --  Skip past the initial character (must be the switch character)
 158
 159       if Ptr = Max then
 160          Bad_Switch (C);
 161       else
 162          Ptr := Ptr + 1;
 163       end if;
 164
 165       --  Handle switches that do not start with -gnat
 166
 167       if Ptr + 3 > Max or else Switch_Chars (Ptr .. Ptr + 3) /= "gnat" then
 168
 169          --  There are two front-end switches that do not start with -gnat:
 170          --  -I, --RTS
 171
 172          if Switch_Chars (Ptr) = 'I' then
 173
 174             --  Set flag Search_Directory_Present if switch is "-I" only:
 175             --  the directory will be the next argument.
 176
 177             if Ptr = Max then
 178                Search_Directory_Present := True;
 179                return;
 180             end if;
 181
 182             Ptr := Ptr + 1;
 183
 184             --  Find out whether this is a -I- or regular -Ixxx switch
 185
 186             --  Note: -I switches are not recorded in the ALI file, since the
 187             --  meaning of the program depends on the source files compiled,
 188             --  not where they came from.
 189
 190             if Ptr = Max and then Switch_Chars (Ptr) = '-' then
 191                Look_In_Primary_Dir := False;
 192             else
 193                Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
 194             end if;
 195
 196          --  Processing of the --RTS switch. --RTS may have been modified by
 197          --  gcc into -fRTS (for GCC targets).
 198
 199          elsif Ptr + 3 <= Max
 200            and then (Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
 201                        or else
 202                      Switch_Chars (Ptr .. Ptr + 3) = "-RTS")
 203          then
 204             Ptr := Ptr + 1;
 205
 206             if Ptr + 4 > Max
 207               or else Switch_Chars (Ptr + 3) /= '='
 208             then
 209                Osint.Fail ("missing path for --RTS");
 210             else
 211                --  Check that this is the first time --RTS is specified or if
 212                --  it is not the first time, the same path has been specified.
 213
 214                if RTS_Specified = null then
 215                   RTS_Specified := new String'(Switch_Chars (Ptr + 4 .. Max));
 216
 217                elsif
 218                  RTS_Specified.all /= Switch_Chars (Ptr + 4 .. Max)
 219                then
 220                   Osint.Fail ("--RTS cannot be specified multiple times");
 221                end if;
 222
 223                --  Valid --RTS switch
 224
 225                Opt.No_Stdinc := True;
 226                Opt.RTS_Switch := True;
 227
 228                RTS_Src_Path_Name :=
 229                  Get_RTS_Search_Dir
 230                    (Switch_Chars (Ptr + 4 .. Max), Include);
 231
 232                RTS_Lib_Path_Name :=
 233                  Get_RTS_Search_Dir
 234                    (Switch_Chars (Ptr + 4 .. Max), Objects);
 235
 236                if RTS_Src_Path_Name /= null
 237                  and then RTS_Lib_Path_Name /= null
 238                then
 239                   --  Store the -fRTS switch (Note: Store_Compilation_Switch
 240                   --  changes -fRTS back into --RTS for the actual output).
 241
 242                   Store_Compilation_Switch (Switch_Chars);
 243
 244                elsif RTS_Src_Path_Name = null
 245                  and then RTS_Lib_Path_Name = null
 246                then
 247                   Osint.Fail ("RTS path not valid: missing " &
 248                               "adainclude and adalib directories");
 249
 250                elsif RTS_Src_Path_Name = null then
 251                   Osint.Fail ("RTS path not valid: missing " &
 252                               "adainclude directory");
 253
 254                elsif RTS_Lib_Path_Name = null then
 255                   Osint.Fail ("RTS path not valid: missing " &
 256                               "adalib directory");
 257                end if;
 258             end if;
 259
 260             --  There are no other switches not starting with -gnat
 261
 262          else
 263             Bad_Switch (Switch_Chars);
 264          end if;
 265
 266       --  Case of switch starting with -gnat
 267
 268       else
 269          Ptr := Ptr + 4;
 270
 271          --  Loop to scan through switches given in switch string
 272
 273          while Ptr <= Max loop
 274             First_Char := Ptr;
 275             Store_Switch := True;
 276
 277             C := Switch_Chars (Ptr);
 278
 279             case C is
 280
 281             --  -gnata (assertions enabled)
 282
 283             when 'a' =>
 284                Ptr := Ptr + 1;
 285                Assertions_Enabled := True;
 286                Debug_Pragmas_Enabled := True;
 287
 288             --  -gnatA (disregard gnat.adc)
 289
 290             when 'A' =>
 291                Ptr := Ptr + 1;
 292                Config_File := False;
 293
 294             --  -gnatb (brief messages to stderr)
 295
 296             when 'b' =>
 297                Ptr := Ptr + 1;
 298                Brief_Output := True;
 299
 300             --  -gnatB (assume no invalid values)
 301
 302             when 'B' =>
 303                Ptr := Ptr + 1;
 304                Assume_No_Invalid_Values := True;
 305
 306             --  -gnatc (check syntax and semantics only)
 307
 308             when 'c' =>
 309                if not First_Switch then
 310                   Osint.Fail
 311                     ("-gnatc must be first if combined with other switches");
 312                end if;
 313
 314                Ptr := Ptr + 1;
 315                Operating_Mode := Check_Semantics;
 316
 317             --  -gnatC (Generate CodePeer information)
 318
 319             when 'C' =>
 320                Ptr := Ptr + 1;
 321
 322                if not CodePeer_Mode then
 323                   CodePeer_Mode := True;
 324
 325                   --  Suppress compiler warnings by default, since what we are
 326                   --  interested in here is what CodePeer can find out. Note
 327                   --  that if -gnatwxxx is specified after -gnatC on the
 328                   --  command line, we do not want to override this setting in
 329                   --  Adjust_Global_Switches, and assume that the user wants to
 330                   --  get both warnings from GNAT and CodePeer messages.
 331
 332                   Warning_Mode := Suppress;
 333                end if;
 334
 335             --  -gnatd (compiler debug options)
 336
 337             when 'd' =>
 338                Store_Switch := False;
 339                Dot := False;
 340                First_Ptr := Ptr + 1;
 341
 342                --  Note: for the debug switch, the remaining characters in this
 343                --  switch field must all be debug flags, since all valid switch
 344                --  characters are also valid debug characters.
 345
 346                --  Loop to scan out debug flags
 347
 348                while Ptr < Max loop
 349                   Ptr := Ptr + 1;
 350                   C := Switch_Chars (Ptr);
 351                   exit when C = ASCII.NUL or else C = '/' or else C = '-';
 352
 353                   if C in '1' .. '9' or else
 354                      C in 'a' .. 'z' or else
 355                      C in 'A' .. 'Z'
 356                   then
 357                      --  Case of dotted flag
 358
 359                      if Dot then
 360                         Set_Dotted_Debug_Flag (C);
 361                         Store_Compilation_Switch ("-gnatd." & C);
 362
 363                         --  Special check, -gnatd.b must come first
 364
 365                         if C = 'b'
 366                           and then (Ptr /= First_Ptr + 1
 367                                       or else not First_Switch)
 368                         then
 369                            Osint.Fail
 370                              ("-gnatd.b must be first if combined "
 371                               & "with other switches");
 372                         end if;
 373
 374                      --  Not a dotted flag
 375
 376                      else
 377                         Set_Debug_Flag (C);
 378                         Store_Compilation_Switch ("-gnatd" & C);
 379                      end if;
 380
 381                   elsif C = '.' then
 382                      Dot := True;
 383
 384                   elsif Dot then
 385                      Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max));
 386                   else
 387                      Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max));
 388                   end if;
 389                end loop;
 390
 391                return;
 392
 393             --  -gnatD (debug expanded code)
 394
 395             when 'D' =>
 396                Ptr := Ptr + 1;
 397
 398                --  Scan optional integer line limit value
 399
 400                if Nat_Present (Switch_Chars, Max, Ptr) then
 401                   Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'D');
 402                   Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
 403                end if;
 404
 405                --  Note: -gnatD also sets -gnatx (to turn off cross-reference
 406                --  generation in the ali file) since otherwise this generation
 407                --  gets confused by the "wrong" Sloc values put in the tree.
 408
 409                Debug_Generated_Code := True;
 410                Xref_Active := False;
 411                Set_Debug_Flag ('g');
 412
 413             --  -gnate? (extended switches)
 414
 415             when 'e' =>
 416                Ptr := Ptr + 1;
 417
 418                --  The -gnate? switches are all double character switches
 419                --  so we must always have a character after the e.
 420
 421                if Ptr > Max then
 422                   Bad_Switch ("-gnate");
 423                end if;
 424
 425                case Switch_Chars (Ptr) is
 426
 427                   --  -gnatea (initial delimiter of explicit switches)
 428
 429                   --  This is an internal switch
 430
 431                   --  All switches that come before -gnatea have been added by
 432                   --  the GCC driver and are not stored in the ALI file.
 433                   --  See also -gnatez below.
 434
 435                   when 'a' =>
 436                      Store_Switch := False;
 437                      Enable_Switch_Storing;
 438                      Ptr := Ptr + 1;
 439
 440                   --  -gnateA (aliasing checks on parameters)
 441
 442                   when 'A' =>
 443                      Ptr := Ptr + 1;
 444                      Check_Aliasing_Of_Parameters := True;
 445
 446                   --  -gnatec (configuration pragmas)
 447
 448                   when 'c' =>
 449                      Store_Switch := False;
 450                      Ptr := Ptr + 1;
 451
 452                      --  There may be an equal sign between -gnatec and
 453                      --  the path name of the config file.
 454
 455                      if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
 456                         Ptr := Ptr + 1;
 457                      end if;
 458
 459                      if Ptr > Max then
 460                         Bad_Switch ("-gnatec");
 461                      end if;
 462
 463                      declare
 464                         Config_File_Name : constant String_Access :=
 465                                              new String'
 466                                                   (Switch_Chars (Ptr .. Max));
 467
 468                      begin
 469                         if Config_File_Names = null then
 470                            Config_File_Names :=
 471                              new String_List'(1 => Config_File_Name);
 472
 473                         else
 474                            declare
 475                               New_Names : constant String_List_Access :=
 476                                             new String_List
 477                                               (1 ..
 478                                                Config_File_Names'Length + 1);
 479
 480                            begin
 481                               for Index in Config_File_Names'Range loop
 482                                  New_Names (Index) :=
 483                                    Config_File_Names (Index);
 484                                  Config_File_Names (Index) := null;
 485                               end loop;
 486
 487                               New_Names (New_Names'Last) := Config_File_Name;
 488                               Free (Config_File_Names);
 489                               Config_File_Names := New_Names;
 490                            end;
 491                         end if;
 492                      end;
 493
 494                      return;
 495
 496                   --  -gnateC switch (CodePeer SCIL generation)
 497
 498                   --  Not enabled for now, keep it for later???
 499                   --  use -gnatd.I only for now
 500
 501                   --  when 'C' =>
 502                   --     Ptr := Ptr + 1;
 503                   --     Generate_SCIL := True;
 504
 505                   --  -gnated switch (disable atomic synchronization)
 506
 507                   when 'd' =>
 508                      Suppress_Options.Suppress (Atomic_Synchronization) :=
 509                        True;
 510
 511                   --  -gnateD switch (preprocessing symbol definition)
 512
 513                   when 'D' =>
 514                      Store_Switch := False;
 515                      Ptr := Ptr + 1;
 516
 517                      if Ptr > Max then
 518                         Bad_Switch ("-gnateD");
 519                      end if;
 520
 521                      Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
 522
 523                      --  Store the switch
 524
 525                      Store_Compilation_Switch
 526                        ("-gnateD" & Switch_Chars (Ptr .. Max));
 527                      Ptr := Max + 1;
 528
 529                   --  -gnateE (extra exception information)
 530
 531                   when 'E' =>
 532                      Exception_Extra_Info := True;
 533                      Ptr := Ptr + 1;
 534
 535                   --  -gnatef (full source path for brief error messages)
 536
 537                   when 'f' =>
 538                      Store_Switch := False;
 539                      Ptr := Ptr + 1;
 540                      Full_Path_Name_For_Brief_Errors := True;
 541
 542                   --  -gnateF (Check_Float_Overflow)
 543
 544                   when 'F' =>
 545                      Ptr := Ptr + 1;
 546                      Check_Float_Overflow := True;
 547
 548                   --  -gnateG (save preprocessor output)
 549
 550                   when 'G' =>
 551                      Generate_Processed_File := True;
 552                      Ptr := Ptr + 1;
 553
 554                   --  -gnatei (max number of instantiations)
 555
 556                   when 'i' =>
 557                      Ptr := Ptr + 1;
 558                      Scan_Pos
 559                        (Switch_Chars, Max, Ptr, Maximum_Instantiations, C);
 560
 561                   --  -gnateI (index of unit in multi-unit source)
 562
 563                   when 'I' =>
 564                      Ptr := Ptr + 1;
 565                      Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
 566
 567                   --  -gnatem (mapping file)
 568
 569                   when 'm' =>
 570                      Store_Switch := False;
 571                      Ptr := Ptr + 1;
 572
 573                      --  There may be an equal sign between -gnatem and
 574                      --  the path name of the mapping file.
 575
 576                      if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
 577                         Ptr := Ptr + 1;
 578                      end if;
 579
 580                      if Ptr > Max then
 581                         Bad_Switch ("-gnatem");
 582                      end if;
 583
 584                      Mapping_File_Name :=
 585                        new String'(Switch_Chars (Ptr .. Max));
 586                      return;
 587
 588                   --  -gnateO= (object path file)
 589
 590                   --  This is an internal switch
 591
 592                   when 'O' =>
 593                      Store_Switch := False;
 594                      Ptr := Ptr + 1;
 595
 596                      --  Check for '='
 597
 598                      if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
 599                         Bad_Switch ("-gnateO");
 600
 601                      else
 602                         Object_Path_File_Name :=
 603                           new String'(Switch_Chars (Ptr + 1 .. Max));
 604                      end if;
 605
 606                      return;
 607
 608                   --  -gnatep (preprocessing data file)
 609
 610                   when 'p' =>
 611                      Store_Switch := False;
 612                      Ptr := Ptr + 1;
 613
 614                      --  There may be an equal sign between -gnatep and
 615                      --  the path name of the mapping file.
 616
 617                      if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
 618                         Ptr := Ptr + 1;
 619                      end if;
 620
 621                      if Ptr > Max then
 622                         Bad_Switch ("-gnatep");
 623                      end if;
 624
 625                      Preprocessing_Data_File :=
 626                        new String'(Switch_Chars (Ptr .. Max));
 627
 628                      --  Store the switch, normalizing to -gnatep=
 629
 630                      Store_Compilation_Switch
 631                        ("-gnatep=" & Preprocessing_Data_File.all);
 632
 633                      Ptr := Max + 1;
 634
 635                   --  -gnateP (Treat pragma Pure/Preelaborate errs as warnings)
 636
 637                   when 'P' =>
 638                      Treat_Categorization_Errors_As_Warnings := True;
 639
 640                   --  -gnateS (generate SCO information)
 641
 642                   --  Include Source Coverage Obligation information in ALI
 643                   --  files for the benefit of source coverage analysis tools
 644                   --  (xcov).
 645
 646                   when 'S' =>
 647                      Generate_SCO := True;
 648                      Generate_SCO_Instance_Table := True;
 649                      Ptr := Ptr + 1;
 650
 651                   --  -gnatet (write target dependent information)
 652
 653                   when 't' =>
 654                      Target_Dependent_Info_Write := True;
 655                      Ptr := Ptr + 1;
 656
 657                   --  -gnateT (read target dependent information)
 658
 659                   when 'T' =>
 660                      if not First_Switch then
 661                         Osint.Fail
 662                           ("-gnateT must be first if combined with "
 663                            & "other switches");
 664                      end if;
 665
 666                      Target_Dependent_Info_Read := True;
 667                      Ptr := Ptr + 1;
 668
 669                   --  -gnateV (validity checks on parameters)
 670
 671                   when 'V' =>
 672                      Ptr := Ptr + 1;
 673                      Check_Validity_Of_Parameters := True;
 674
 675                   --  -gnateY (ignore Style_Checks pragmas)
 676
 677                   when 'Y' =>
 678                      Ignore_Style_Checks_Pragmas := True;
 679                      Ptr := Ptr + 1;
 680
 681                   --  -gnatez (final delimiter of explicit switches)
 682
 683                   --  This is an internal switch
 684
 685                   --  All switches that come after -gnatez have been added by
 686                   --  the GCC driver and are not stored in the ALI file. See
 687                   --  also -gnatea above.
 688
 689                   when 'z' =>
 690                      Store_Switch := False;
 691                      Disable_Switch_Storing;
 692                      Ptr := Ptr + 1;
 693
 694                   --  All other -gnate? switches are unassigned
 695
 696                   when others =>
 697                      Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max));
 698                end case;
 699
 700             --  -gnatE (dynamic elaboration checks)
 701
 702             when 'E' =>
 703                Ptr := Ptr + 1;
 704                Dynamic_Elaboration_Checks := True;
 705
 706             --  -gnatf (full error messages)
 707
 708             when 'f' =>
 709                Ptr := Ptr + 1;
 710                All_Errors_Mode := True;
 711
 712             --  -gnatF (overflow of predefined float types)
 713
 714             when 'F' =>
 715                Ptr := Ptr + 1;
 716                External_Name_Exp_Casing := Uppercase;
 717                External_Name_Imp_Casing := Uppercase;
 718
 719             --  -gnatg (GNAT implementation mode)
 720
 721             when 'g' =>
 722                Ptr := Ptr + 1;
 723                GNAT_Mode := True;
 724                Identifier_Character_Set := 'n';
 725                System_Extend_Unit := Empty;
 726                Warning_Mode := Treat_As_Error;
 727
 728                --  Set Ada 2012 mode explicitly. We don't want to rely on the
 729                --  implicit setting here, since for example, we want
 730                --  Preelaborate_05 treated as Preelaborate
 731
 732                Ada_Version := Ada_2012;
 733                Ada_Version_Explicit := Ada_Version;
 734
 735                --  Set default warnings and style checks for -gnatg
 736
 737                Set_GNAT_Mode_Warnings;
 738                Set_GNAT_Style_Check_Options;
 739
 740             --  -gnatG (output generated code)
 741
 742             when 'G' =>
 743                Ptr := Ptr + 1;
 744                Print_Generated_Code := True;
 745
 746                --  Scan optional integer line limit value
 747
 748                if Nat_Present (Switch_Chars, Max, Ptr) then
 749                   Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G');
 750                   Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
 751                end if;
 752
 753             --  -gnath (help information)
 754
 755             when 'h' =>
 756                Ptr := Ptr + 1;
 757                Usage_Requested := True;
 758
 759             --  -gnati (character set)
 760
 761             when 'i' =>
 762                if Ptr = Max then
 763                   Bad_Switch ("-gnati");
 764                end if;
 765
 766                Ptr := Ptr + 1;
 767                C := Switch_Chars (Ptr);
 768
 769                if C in '1' .. '5'
 770                  or else C = '8'
 771                  or else C = '9'
 772                  or else C = 'p'
 773                  or else C = 'f'
 774                  or else C = 'n'
 775                  or else C = 'w'
 776                then
 777                   Identifier_Character_Set := C;
 778                   Ptr := Ptr + 1;
 779
 780                else
 781                   Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max));
 782                end if;
 783
 784             --  -gnatI (ignore representation clauses)
 785
 786             when 'I' =>
 787                Ptr := Ptr + 1;
 788                Ignore_Rep_Clauses := True;
 789
 790             --  -gnatj (messages in limited length lines)
 791
 792             when 'j' =>
 793                Ptr := Ptr + 1;
 794                Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
 795
 796             --  -gnatk (limit file name length)
 797
 798             when 'k' =>
 799                Ptr := Ptr + 1;
 800                   Scan_Pos
 801                     (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
 802
 803             --  -gnatl (output full source)
 804
 805             when 'l' =>
 806                Ptr := Ptr + 1;
 807                Full_List := True;
 808
 809                --  There may be an equal sign between -gnatl and a file name
 810
 811                if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
 812                   if Ptr = Max then
 813                      Osint.Fail ("file name for -gnatl= is null");
 814                   else
 815                      Opt.Full_List_File_Name :=
 816                        new String'(Switch_Chars (Ptr + 1 .. Max));
 817                      Ptr := Max + 1;
 818                   end if;
 819                end if;
 820
 821             --  -gnatL (corresponding source text)
 822
 823             when 'L' =>
 824                Ptr := Ptr + 1;
 825                Dump_Source_Text := True;
 826
 827             --  -gnatm (max number or errors/warnings)
 828
 829             when 'm' =>
 830                Ptr := Ptr + 1;
 831                Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C);
 832
 833             --  -gnatn (enable pragma Inline)
 834
 835             when 'n' =>
 836                Ptr := Ptr + 1;
 837                Inline_Active := True;
 838
 839                --  There may be a digit (1 or 2) appended to the switch
 840
 841                if Ptr <= Max then
 842                   C := Switch_Chars (Ptr);
 843
 844                   if C in '1' .. '2' then
 845                      Ptr := Ptr + 1;
 846                      Inline_Level := Character'Pos (C) - Character'Pos ('0');
 847                   end if;
 848                end if;
 849
 850             --  -gnatN (obsolescent)
 851
 852             when 'N' =>
 853                Ptr := Ptr + 1;
 854                Inline_Active := True;
 855                Front_End_Inlining := True;
 856
 857             --  -gnato (overflow checks)
 858
 859             when 'o' =>
 860                Ptr := Ptr + 1;
 861                Suppress_Options.Suppress (Overflow_Check) := False;
 862
 863                --  Case of no digits after the -gnato
 864
 865                if Ptr > Max or else Switch_Chars (Ptr) not in '1' .. '3' then
 866                   Suppress_Options.Overflow_Mode_General    := Strict;
 867                   Suppress_Options.Overflow_Mode_Assertions := Strict;
 868
 869                --  At least one digit after the -gnato
 870
 871                else
 872                   --  Handle first digit after -gnato
 873
 874                   Suppress_Options.Overflow_Mode_General :=
 875                     Get_Overflow_Mode (Switch_Chars (Ptr));
 876                   Ptr := Ptr + 1;
 877
 878                   --  Only one digit after -gnato, set assertions mode to
 879                   --  be the same as general mode.
 880
 881                   if Ptr > Max
 882                     or else Switch_Chars (Ptr) not in '1' .. '3'
 883                   then
 884                      Suppress_Options.Overflow_Mode_Assertions :=
 885                        Suppress_Options.Overflow_Mode_General;
 886
 887                   --  Process second digit after -gnato
 888
 889                   else
 890                      Suppress_Options.Overflow_Mode_Assertions :=
 891                        Get_Overflow_Mode (Switch_Chars (Ptr));
 892                      Ptr := Ptr + 1;
 893                   end if;
 894                end if;
 895
 896             --  -gnatO (specify name of the object file)
 897
 898             --  This is an internal switch
 899
 900             when 'O' =>
 901                Store_Switch := False;
 902                Ptr := Ptr + 1;
 903                Output_File_Name_Present := True;
 904
 905             --  -gnatp (suppress all checks)
 906
 907             when 'p' =>
 908                Ptr := Ptr + 1;
 909
 910                --  Skip processing if cancelled by subsequent -gnat-p
 911
 912                if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then
 913                   Store_Switch := False;
 914
 915                else
 916                   --  Set all specific options as well as All_Checks in the
 917                   --  Suppress_Options array, excluding Elaboration_Check,
 918                   --  since this is treated specially because we do not want
 919                   --  -gnatp to disable static elaboration processing. Also
 920                   --  exclude Atomic_Synchronization, since this is not a real
 921                   --  check.
 922
 923                   for J in Suppress_Options.Suppress'Range loop
 924                      if J /= Elaboration_Check
 925                           and then
 926                         J /= Atomic_Synchronization
 927                      then
 928                         Suppress_Options.Suppress (J) := True;
 929                      end if;
 930                   end loop;
 931
 932                   Validity_Checks_On  := False;
 933                   Opt.Suppress_Checks := True;
 934                end if;
 935
 936             --  -gnatP (periodic poll)
 937
 938             when 'P' =>
 939                Ptr := Ptr + 1;
 940                Polling_Required := True;
 941
 942             --  -gnatq (don't quit)
 943
 944             when 'q' =>
 945                Ptr := Ptr + 1;
 946                Try_Semantics := True;
 947
 948             --  -gnatQ (always write ALI file)
 949
 950             when 'Q' =>
 951                Ptr := Ptr + 1;
 952                Force_ALI_Tree_File := True;
 953                Try_Semantics := True;
 954
 955             --  -gnatr (restrictions as warnings)
 956
 957             when 'r' =>
 958                Ptr := Ptr + 1;
 959                Treat_Restrictions_As_Warnings := True;
 960
 961             --  -gnatR (list rep. info)
 962
 963             when 'R' =>
 964                Back_Annotate_Rep_Info := True;
 965                List_Representation_Info := 1;
 966
 967                Ptr := Ptr + 1;
 968                while Ptr <= Max loop
 969                   C := Switch_Chars (Ptr);
 970
 971                   if C in '1' .. '3' then
 972                      List_Representation_Info :=
 973                        Character'Pos (C) - Character'Pos ('0');
 974
 975                   elsif Switch_Chars (Ptr) = 's' then
 976                      List_Representation_Info_To_File := True;
 977
 978                   elsif Switch_Chars (Ptr) = 'm' then
 979                      List_Representation_Info_Mechanisms := True;
 980
 981                   else
 982                      Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
 983                   end if;
 984
 985                   Ptr := Ptr + 1;
 986                end loop;
 987
 988             --  -gnats (syntax check only)
 989
 990             when 's' =>
 991                if not First_Switch then
 992                   Osint.Fail
 993                     ("-gnats must be first if combined with other switches");
 994                end if;
 995
 996                Ptr := Ptr + 1;
 997                Operating_Mode := Check_Syntax;
 998
 999             --  -gnatS (print package Standard)
1000
1001             when 'S' =>
1002                Print_Standard := True;
1003                Ptr := Ptr + 1;
1004
1005             --  -gnatt (output tree)
1006
1007             when 't' =>
1008                Ptr := Ptr + 1;
1009                Tree_Output := True;
1010                Back_Annotate_Rep_Info := True;
1011
1012             --  -gnatT (change start of internal table sizes)
1013
1014             when 'T' =>
1015                Ptr := Ptr + 1;
1016                Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
1017
1018             --  -gnatu (list units for compilation)
1019
1020             when 'u' =>
1021                Ptr := Ptr + 1;
1022                List_Units := True;
1023
1024             --  -gnatU (unique tags)
1025
1026             when 'U' =>
1027                Ptr := Ptr + 1;
1028                Unique_Error_Tag := True;
1029
1030             --  -gnatv (verbose mode)
1031
1032             when 'v' =>
1033                Ptr := Ptr + 1;
1034                Verbose_Mode := True;
1035
1036             --  -gnatV (validity checks)
1037
1038             when 'V' =>
1039                Store_Switch := False;
1040                Ptr := Ptr + 1;
1041
1042                if Ptr > Max then
1043                   Bad_Switch ("-gnatV");
1044
1045                else
1046                   declare
1047                      OK  : Boolean;
1048
1049                   begin
1050                      Set_Validity_Check_Options
1051                        (Switch_Chars (Ptr .. Max), OK, Ptr);
1052
1053                      if not OK then
1054                         Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max));
1055                      end if;
1056
1057                      for Index in First_Char + 1 .. Max loop
1058                         Store_Compilation_Switch
1059                           ("-gnatV" & Switch_Chars (Index));
1060                      end loop;
1061                   end;
1062                end if;
1063
1064                Ptr := Max + 1;
1065
1066             --  -gnatw (warning modes)
1067
1068             when 'w' =>
1069                Store_Switch := False;
1070                Ptr := Ptr + 1;
1071
1072                if Ptr > Max then
1073                   Bad_Switch ("-gnatw");
1074                end if;
1075
1076                while Ptr <= Max loop
1077                   C := Switch_Chars (Ptr);
1078
1079                   --  Case of dot switch
1080
1081                   if C = '.' and then Ptr < Max then
1082                      Ptr := Ptr + 1;
1083                      C := Switch_Chars (Ptr);
1084
1085                      if Set_Dot_Warning_Switch (C) then
1086                         Store_Compilation_Switch ("-gnatw." & C);
1087                      else
1088                         Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max));
1089                      end if;
1090
1091                      --  Normal case, no dot
1092
1093                   else
1094                      if Set_Warning_Switch (C) then
1095                         Store_Compilation_Switch ("-gnatw" & C);
1096                      else
1097                         Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max));
1098                      end if;
1099                   end if;
1100
1101                   Ptr := Ptr + 1;
1102                end loop;
1103
1104                return;
1105
1106             --  -gnatW (wide character encoding method)
1107
1108             when 'W' =>
1109                Ptr := Ptr + 1;
1110
1111                if Ptr > Max then
1112                   Bad_Switch ("-gnatW");
1113                end if;
1114
1115                begin
1116                   Wide_Character_Encoding_Method :=
1117                     Get_WC_Encoding_Method (Switch_Chars (Ptr));
1118                exception
1119                   when Constraint_Error =>
1120                      Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max));
1121                end;
1122
1123                Wide_Character_Encoding_Method_Specified := True;
1124
1125                Upper_Half_Encoding :=
1126                  Wide_Character_Encoding_Method in
1127                    WC_Upper_Half_Encoding_Method;
1128
1129                Ptr := Ptr + 1;
1130
1131             --  -gnatx (suppress cross-ref information)
1132
1133             when 'x' =>
1134                Ptr := Ptr + 1;
1135                Xref_Active := False;
1136
1137             --  -gnatX (language extensions)
1138
1139             when 'X' =>
1140                Ptr := Ptr + 1;
1141                Extensions_Allowed   := True;
1142                Ada_Version          := Ada_Version_Type'Last;
1143                Ada_Version_Explicit := Ada_Version_Type'Last;
1144
1145             --  -gnaty (style checks)
1146
1147             when 'y' =>
1148                Ptr := Ptr + 1;
1149
1150                if Ptr > Max then
1151                   Set_Default_Style_Check_Options;
1152
1153                else
1154                   Store_Switch := False;
1155
1156                   declare
1157                      OK  : Boolean;
1158
1159                   begin
1160                      Set_Style_Check_Options
1161                        (Switch_Chars (Ptr .. Max), OK, Ptr);
1162
1163                      if not OK then
1164                         Osint.Fail
1165                           ("bad -gnaty switch (" &
1166                            Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
1167                      end if;
1168
1169                      Ptr := First_Char + 1;
1170                      while Ptr <= Max loop
1171                         if Switch_Chars (Ptr) = 'M' then
1172                            First_Char := Ptr;
1173                            loop
1174                               Ptr := Ptr + 1;
1175                               exit when Ptr > Max
1176                                 or else Switch_Chars (Ptr) not in '0' .. '9';
1177                            end loop;
1178
1179                            Store_Compilation_Switch
1180                              ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1));
1181
1182                         else
1183                            Store_Compilation_Switch
1184                              ("-gnaty" & Switch_Chars (Ptr));
1185                            Ptr := Ptr + 1;
1186                         end if;
1187                      end loop;
1188                   end;
1189                end if;
1190
1191             --  -gnatz (stub generation)
1192
1193             when 'z' =>
1194
1195                --  -gnatz must be the first and only switch in Switch_Chars,
1196                --  and is a two-letter switch.
1197
1198                if Ptr /= Switch_Chars'First + 5
1199                  or else (Max - Ptr + 1) > 2
1200                then
1201                   Osint.Fail
1202                     ("-gnatz* may not be combined with other switches");
1203                end if;
1204
1205                if Ptr = Max then
1206                   Bad_Switch ("-gnatz");
1207                end if;
1208
1209                Ptr := Ptr + 1;
1210
1211                --  Only one occurrence of -gnat* is permitted
1212
1213                if Distribution_Stub_Mode = No_Stubs then
1214                   case Switch_Chars (Ptr) is
1215                      when 'r' =>
1216                         Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
1217
1218                      when 'c' =>
1219                         Distribution_Stub_Mode := Generate_Caller_Stub_Body;
1220
1221                      when others =>
1222                         Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
1223                   end case;
1224
1225                   Ptr := Ptr + 1;
1226
1227                else
1228                   Osint.Fail ("only one -gnatz* switch allowed");
1229                end if;
1230
1231             --  -gnatZ (obsolescent)
1232
1233             when 'Z' =>
1234                Ptr := Ptr + 1;
1235                Osint.Fail
1236                  ("-gnatZ is no longer supported: consider using --RTS=zcx");
1237
1238             --  Note on language version switches: whenever a new language
1239             --  version switch is added, Switch.M.Normalize_Compiler_Switches
1240             --  must be updated.
1241
1242             --  -gnat83
1243
1244             when '8' =>
1245                if Ptr = Max then
1246                   Bad_Switch ("-gnat8");
1247                end if;
1248
1249                Ptr := Ptr + 1;
1250
1251                if Switch_Chars (Ptr) /= '3' then
1252                   Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
1253                else
1254                   Ptr := Ptr + 1;
1255                   Ada_Version := Ada_83;
1256                   Ada_Version_Explicit := Ada_Version;
1257                end if;
1258
1259             --  -gnat95
1260
1261             when '9' =>
1262                if Ptr = Max then
1263                   Bad_Switch ("-gnat9");
1264                end if;
1265
1266                Ptr := Ptr + 1;
1267
1268                if Switch_Chars (Ptr) /= '5' then
1269                   Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
1270                else
1271                   Ptr := Ptr + 1;
1272                   Ada_Version := Ada_95;
1273                   Ada_Version_Explicit := Ada_Version;
1274                end if;
1275
1276             --  -gnat05
1277
1278             when '0' =>
1279                if Ptr = Max then
1280                   Bad_Switch ("-gnat0");
1281                end if;
1282
1283                Ptr := Ptr + 1;
1284
1285                if Switch_Chars (Ptr) /= '5' then
1286                   Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
1287                else
1288                   Ptr := Ptr + 1;
1289                   Ada_Version := Ada_2005;
1290                   Ada_Version_Explicit := Ada_Version;
1291                end if;
1292
1293             --  -gnat12
1294
1295             when '1' =>
1296                if Ptr = Max then
1297                   Bad_Switch ("-gnat1");
1298                end if;
1299
1300                Ptr := Ptr + 1;
1301
1302                if Switch_Chars (Ptr) /= '2' then
1303                   Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
1304                else
1305                   Ptr := Ptr + 1;
1306                   Ada_Version := Ada_2012;
1307                   Ada_Version_Explicit := Ada_Version;
1308                end if;
1309
1310             --  -gnat2005 and -gnat2012
1311
1312             when '2' =>
1313                if Ptr > Max - 3 then
1314                   Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1315
1316                elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" then
1317                   Ada_Version := Ada_2005;
1318
1319                elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
1320                   Ada_Version := Ada_2012;
1321
1322                else
1323                   Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
1324                end if;
1325
1326                Ada_Version_Explicit := Ada_Version;
1327                Ptr := Ptr + 4;
1328
1329             --  Switch cancellation, currently only -gnat-p is allowed.
1330             --  All we do here is the error checking, since the actual
1331             --  processing for switch cancellation is done by calls to
1332             --  Switch_Subsequently_Cancelled at the appropriate point.
1333
1334             when '-' =>
1335
1336                --  Simple ignore -gnat-p
1337
1338                if Switch_Chars = "-gnat-p" then
1339                   return;
1340
1341                --  Any other occurrence of minus is ignored. This is for
1342                --  maximum compatibility with previous version which ignored
1343                --  all occurrences of minus.
1344
1345                else
1346                   Store_Switch := False;
1347                   Ptr := Ptr + 1;
1348                end if;
1349
1350             --  We ignore '/' in switches, this is historical, still needed???
1351
1352             when '/' =>
1353                Store_Switch := False;
1354
1355             --  Anything else is an error (illegal switch character)
1356
1357             when others =>
1358                Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1359             end case;
1360
1361             if Store_Switch then
1362                Store_Compilation_Switch
1363                  ("-gnat" & Switch_Chars (First_Char .. Ptr - 1));
1364             end if;
1365
1366             First_Switch := False;
1367          end loop;
1368       end if;
1369    end Scan_Front_End_Switches;
1370
1371    -----------------------------------
1372    -- Switch_Subsequently_Cancelled --
1373    -----------------------------------
1374
1375    function Switch_Subsequently_Cancelled
1376      (C        : String;
1377       Args     : String_List;
1378       Arg_Rank : Positive) return Boolean
1379    is
1380    begin
1381       --  Loop through arguments following the current one
1382
1383       for Arg in Arg_Rank + 1 .. Args'Last loop
1384          if Args (Arg).all = "-gnat-" & C then
1385             return True;
1386          end if;
1387       end loop;
1388
1389       --  No match found, not cancelled
1390
1391       return False;
1392    end Switch_Subsequently_Cancelled;
1393
1394 end Switch.C;