gcc/ada/switch.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               S W I T C H                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.194 $
  10 --                                                                          --
  11 --          Copyright (C) 1992-2001, Free Software Foundation, Inc.         --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 --  Option switch scanning for both the compiler and the binder
  30
  31 --  Note: this version of the package should be usable in both Unix and DOS
  32
  33 with Debug;    use Debug;
  34 with Osint;    use Osint;
  35 with Opt;      use Opt;
  36 with Validsw;  use Validsw;
  37 with Stylesw;  use Stylesw;
  38 with Types;    use Types;
  39
  40 with System.WCh_Con; use System.WCh_Con;
  41
  42 package body Switch is
  43
  44    Bad_Switch : exception;
  45    --  Exception raised if bad switch encountered
  46
  47    Bad_Switch_Value : exception;
  48    --  Exception raised if bad switch value encountered
  49
  50    Missing_Switch_Value : exception;
  51    --  Exception raised if no switch value encountered
  52
  53    Too_Many_Output_Files : exception;
  54    --  Exception raised if the -o switch is encountered more than once
  55
  56    Switch_Max_Value : constant := 999;
  57    --  Maximum value permitted in switches that take a value
  58
  59    procedure Scan_Nat
  60      (Switch_Chars : String;
  61       Max          : Integer;
  62       Ptr          : in out Integer;
  63       Result       : out Nat);
  64    --  Scan natural integer parameter for switch. On entry, Ptr points
  65    --  just past the switch character, on exit it points past the last
  66    --  digit of the integer value.
  67
  68    procedure Scan_Pos
  69      (Switch_Chars : String;
  70       Max          : Integer;
  71       Ptr          : in out Integer;
  72       Result       : out Pos);
  73    --  Scan positive integer parameter for switch. On entry, Ptr points
  74    --  just past the switch character, on exit it points past the last
  75    --  digit of the integer value.
  76
  77    -------------------------
  78    -- Is_Front_End_Switch --
  79    -------------------------
  80
  81    function Is_Front_End_Switch (Switch_Chars : String) return Boolean is
  82       Ptr       : constant Positive := Switch_Chars'First;
  83    begin
  84       return Is_Switch (Switch_Chars)
  85         and then
  86           (Switch_Chars (Ptr + 1) = 'I'
  87              or else
  88           (Switch_Chars'Length >= 5
  89                          and then Switch_Chars (Ptr + 1 .. Ptr + 4) = "gnat"));
  90    end Is_Front_End_Switch;
  91
  92    ---------------
  93    -- Is_Switch --
  94    ---------------
  95
  96    function Is_Switch (Switch_Chars : String) return Boolean is
  97    begin
  98       return Switch_Chars'Length > 1
  99         and then (Switch_Chars (Switch_Chars'First) = '-'
 100                      or
 101                   Switch_Chars (Switch_Chars'First) = Switch_Character);
 102    end Is_Switch;
 103
 104    --------------------------
 105    -- Scan_Binder_Switches --
 106    --------------------------
 107
 108    procedure Scan_Binder_Switches (Switch_Chars : String) is
 109       Ptr : Integer := Switch_Chars'First;
 110       Max : Integer := Switch_Chars'Last;
 111       C   : Character := ' ';
 112
 113    begin
 114       --  Skip past the initial character (must be the switch character)
 115
 116       if Ptr = Max then
 117          raise Bad_Switch;
 118       else
 119          Ptr := Ptr + 1;
 120       end if;
 121
 122       --  A little check, "gnat" at the start of a switch is not allowed
 123       --  except for the compiler
 124
 125       if Switch_Chars'Last >= Ptr + 3
 126         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
 127       then
 128          Osint.Fail ("invalid switch: """, Switch_Chars, """"
 129             & " (gnat not needed here)");
 130
 131       end if;
 132
 133       --  Loop to scan through switches given in switch string
 134
 135       while Ptr <= Max loop
 136          C := Switch_Chars (Ptr);
 137
 138          case C is
 139
 140          --  Processing for A switch
 141
 142          when 'A' =>
 143             Ptr := Ptr + 1;
 144
 145             Ada_Bind_File := True;
 146
 147          --  Processing for b switch
 148
 149          when 'b' =>
 150             Ptr := Ptr + 1;
 151             Brief_Output := True;
 152
 153          --  Processing for c switch
 154
 155          when 'c' =>
 156             Ptr := Ptr + 1;
 157
 158             Check_Only := True;
 159
 160          --  Processing for C switch
 161
 162          when 'C' =>
 163             Ptr := Ptr + 1;
 164
 165             Ada_Bind_File := False;
 166
 167          --  Processing for d switch
 168
 169          when 'd' =>
 170
 171             --  Note: for the debug switch, the remaining characters in this
 172             --  switch field must all be debug flags, since all valid switch
 173             --  characters are also valid debug characters.
 174
 175             --  Loop to scan out debug flags
 176
 177             while Ptr < Max loop
 178                Ptr := Ptr + 1;
 179                C := Switch_Chars (Ptr);
 180                exit when C = ASCII.NUL or else C = '/' or else C = '-';
 181
 182                if C in '1' .. '9' or else
 183                   C in 'a' .. 'z' or else
 184                   C in 'A' .. 'Z'
 185                then
 186                   Set_Debug_Flag (C);
 187                else
 188                   raise Bad_Switch;
 189                end if;
 190             end loop;
 191
 192             --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
 193             --  is for backwards compatibility with old versions and usage.
 194
 195             if Debug_Flag_XX then
 196                Zero_Cost_Exceptions_Set := True;
 197                Zero_Cost_Exceptions_Val := True;
 198             end if;
 199
 200             return;
 201
 202          --  Processing for e switch
 203
 204          when 'e' =>
 205             Ptr := Ptr + 1;
 206             Elab_Dependency_Output := True;
 207
 208          --  Processing for E switch
 209
 210          when 'E' =>
 211             Ptr := Ptr + 1;
 212             Exception_Tracebacks := True;
 213
 214          --  Processing for f switch
 215
 216          when 'f' =>
 217             Ptr := Ptr + 1;
 218             Force_RM_Elaboration_Order := True;
 219
 220          --  Processing for g switch
 221
 222          when 'g' =>
 223             Ptr := Ptr + 1;
 224             if Ptr <= Max then
 225                C := Switch_Chars (Ptr);
 226                if C in '0' .. '3' then
 227                   Debugger_Level :=
 228                     Character'Pos
 229                       (Switch_Chars (Ptr)) - Character'Pos ('0');
 230                   Ptr := Ptr + 1;
 231                end if;
 232             else
 233                Debugger_Level := 2;
 234             end if;
 235
 236          --  Processing for G switch
 237
 238          when 'G' =>
 239             Ptr := Ptr + 1;
 240             Print_Generated_Code := True;
 241
 242          --  Processing for h switch
 243
 244          when 'h' =>
 245             Ptr := Ptr + 1;
 246             Usage_Requested := True;
 247
 248          --  Processing for i switch
 249
 250          when 'i' =>
 251             if Ptr = Max then
 252                raise Bad_Switch;
 253             end if;
 254
 255             Ptr := Ptr + 1;
 256             C := Switch_Chars (Ptr);
 257
 258             if C = '1' or else
 259                C = '2' or else
 260                C = '3' or else
 261                C = '4' or else
 262                C = '8' or else
 263                C = 'p' or else
 264                C = 'f' or else
 265                C = 'n' or else
 266                C = 'w'
 267             then
 268                Identifier_Character_Set := C;
 269                Ptr := Ptr + 1;
 270             else
 271                raise Bad_Switch;
 272             end if;
 273
 274          --  Processing for K switch
 275
 276          when 'K' =>
 277             Ptr := Ptr + 1;
 278
 279             if Program = Binder then
 280                Output_Linker_Option_List := True;
 281             else
 282                raise Bad_Switch;
 283             end if;
 284
 285          --  Processing for l switch
 286
 287          when 'l' =>
 288             Ptr := Ptr + 1;
 289             Elab_Order_Output := True;
 290
 291          --  Processing for m switch
 292
 293          when 'm' =>
 294             Ptr := Ptr + 1;
 295             Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
 296
 297          --  Processing for n switch
 298
 299          when 'n' =>
 300             Ptr := Ptr + 1;
 301             Bind_Main_Program := False;
 302
 303             --  Note: The -L option of the binder also implies -n, so
 304             --  any change here must also be reflected in the processing
 305             --  for -L that is found in Gnatbind.Scan_Bind_Arg.
 306
 307          --  Processing for o switch
 308
 309          when 'o' =>
 310             Ptr := Ptr + 1;
 311
 312             if Output_File_Name_Present then
 313                raise Too_Many_Output_Files;
 314
 315             else
 316                Output_File_Name_Present := True;
 317             end if;
 318
 319          --  Processing for O switch
 320
 321          when 'O' =>
 322             Ptr := Ptr + 1;
 323             Output_Object_List := True;
 324
 325          --  Processing for p switch
 326
 327          when 'p' =>
 328             Ptr := Ptr + 1;
 329             Pessimistic_Elab_Order := True;
 330
 331          --  Processing for q switch
 332
 333          when 'q' =>
 334             Ptr := Ptr + 1;
 335             Quiet_Output := True;
 336
 337          --  Processing for s switch
 338
 339          when 's' =>
 340             Ptr := Ptr + 1;
 341             All_Sources := True;
 342             Check_Source_Files := True;
 343
 344          --  Processing for t switch
 345
 346          when 't' =>
 347             Ptr := Ptr + 1;
 348             Tolerate_Consistency_Errors := True;
 349
 350          --  Processing for T switch
 351
 352          when 'T' =>
 353             Ptr := Ptr + 1;
 354             Time_Slice_Set := True;
 355             Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);
 356
 357          --  Processing for v switch
 358
 359          when 'v' =>
 360             Ptr := Ptr + 1;
 361             Verbose_Mode := True;
 362
 363          --  Processing for w switch
 364
 365          when 'w' =>
 366
 367             --  For the binder we only allow suppress/error cases
 368
 369             Ptr := Ptr + 1;
 370
 371             case Switch_Chars (Ptr) is
 372
 373                when 'e' =>
 374                   Warning_Mode  := Treat_As_Error;
 375
 376                when 's' =>
 377                   Warning_Mode  := Suppress;
 378
 379                when others =>
 380                   raise Bad_Switch;
 381             end case;
 382
 383             Ptr := Ptr + 1;
 384
 385          --  Processing for W switch
 386
 387          when 'W' =>
 388             Ptr := Ptr + 1;
 389
 390             for J in WC_Encoding_Method loop
 391                if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
 392                   Wide_Character_Encoding_Method := J;
 393                   exit;
 394
 395                elsif J = WC_Encoding_Method'Last then
 396                   raise Bad_Switch;
 397                end if;
 398             end loop;
 399
 400             Upper_Half_Encoding :=
 401               Wide_Character_Encoding_Method in
 402                 WC_Upper_Half_Encoding_Method;
 403
 404             Ptr := Ptr + 1;
 405
 406          --  Processing for x switch
 407
 408          when 'x' =>
 409             Ptr := Ptr + 1;
 410             All_Sources := False;
 411             Check_Source_Files := False;
 412
 413          --  Processing for z switch
 414
 415          when 'z' =>
 416             Ptr := Ptr + 1;
 417             No_Main_Subprogram := True;
 418
 419          --  Ignore extra switch character
 420
 421          when '/' | '-' =>
 422             Ptr := Ptr + 1;
 423
 424          --  Anything else is an error (illegal switch character)
 425
 426          when others =>
 427             raise Bad_Switch;
 428          end case;
 429       end loop;
 430
 431    exception
 432       when Bad_Switch =>
 433          Osint.Fail ("invalid switch: ", (1 => C));
 434
 435       when Bad_Switch_Value =>
 436          Osint.Fail ("numeric value too big for switch: ", (1 => C));
 437
 438       when Missing_Switch_Value =>
 439          Osint.Fail ("missing numeric value for switch: ", (1 => C));
 440
 441       when Too_Many_Output_Files =>
 442          Osint.Fail ("duplicate -o switch");
 443    end Scan_Binder_Switches;
 444
 445    -----------------------------
 446    -- Scan_Front_End_Switches --
 447    -----------------------------
 448
 449    procedure Scan_Front_End_Switches (Switch_Chars : String) is
 450       Switch_Starts_With_Gnat : Boolean;
 451       Ptr : Integer := Switch_Chars'First;
 452       Max : constant Integer := Switch_Chars'Last;
 453       C   : Character := ' ';
 454
 455    begin
 456       --  Skip past the initial character (must be the switch character)
 457
 458       if Ptr = Max then
 459          raise Bad_Switch;
 460
 461       else
 462          Ptr := Ptr + 1;
 463       end if;
 464
 465       --  A little check, "gnat" at the start of a switch is not allowed
 466       --  except for the compiler (where it was already removed)
 467
 468       Switch_Starts_With_Gnat :=
 469          Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
 470
 471       if Switch_Starts_With_Gnat then
 472          Ptr := Ptr + 4;
 473       end if;
 474
 475       --  Loop to scan through switches given in switch string
 476
 477       while Ptr <= Max loop
 478          C := Switch_Chars (Ptr);
 479
 480          --  Processing for a switch
 481
 482          case Switch_Starts_With_Gnat is
 483
 484          when False =>
 485             --  There is only one front-end switch that
 486             --  does not start with -gnat, namely -I
 487
 488             case C is
 489
 490             when 'I' =>
 491                Ptr := Ptr + 1;
 492
 493                if Ptr > Max then
 494                   raise Bad_Switch;
 495                end if;
 496
 497                --  Find out whether this is a -I- or regular -Ixxx switch
 498
 499                if Ptr = Max and then Switch_Chars (Ptr) = '-' then
 500                   Look_In_Primary_Dir := False;
 501
 502                else
 503                   Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
 504                end if;
 505
 506                Ptr := Max + 1;
 507
 508             when others =>
 509                --  Should not happen, as Scan_Switches is supposed
 510                --  to be called for front-end switches only.
 511                --  Still, it is safest to raise Bad_Switch error.
 512
 513                raise Bad_Switch;
 514             end case;
 515
 516          when True =>
 517             --  Process -gnat* options
 518
 519             case C is
 520
 521             when 'a' =>
 522                Ptr := Ptr + 1;
 523                Assertions_Enabled := True;
 524
 525             --  Processing for A switch
 526
 527             when 'A' =>
 528                Ptr := Ptr + 1;
 529                Config_File := False;
 530
 531             --  Processing for b switch
 532
 533             when 'b' =>
 534                Ptr := Ptr + 1;
 535                Brief_Output := True;
 536
 537             --  Processing for c switch
 538
 539             when 'c' =>
 540                Ptr := Ptr + 1;
 541                Operating_Mode := Check_Semantics;
 542
 543             --  Processing for C switch
 544
 545             when 'C' =>
 546                Ptr := Ptr + 1;
 547                Compress_Debug_Names := True;
 548
 549             --  Processing for d switch
 550
 551             when 'd' =>
 552
 553                --  Note: for the debug switch, the remaining characters in this
 554                --  switch field must all be debug flags, since all valid switch
 555                --  characters are also valid debug characters.
 556
 557                --  Loop to scan out debug flags
 558
 559                while Ptr < Max loop
 560                   Ptr := Ptr + 1;
 561                   C := Switch_Chars (Ptr);
 562                   exit when C = ASCII.NUL or else C = '/' or else C = '-';
 563
 564                   if C in '1' .. '9' or else
 565                      C in 'a' .. 'z' or else
 566                      C in 'A' .. 'Z'
 567                   then
 568                      Set_Debug_Flag (C);
 569
 570                   else
 571                      raise Bad_Switch;
 572                   end if;
 573                end loop;
 574
 575                --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
 576                --  is for backwards compatibility with old versions and usage.
 577
 578                if Debug_Flag_XX then
 579                   Zero_Cost_Exceptions_Set := True;
 580                   Zero_Cost_Exceptions_Val := True;
 581                end if;
 582
 583                return;
 584
 585             --  Processing for D switch
 586
 587             when 'D' =>
 588                Ptr := Ptr + 1;
 589
 590                --  Note: -gnatD also sets -gnatx (to turn off cross-reference
 591                --  generation in the ali file) since otherwise this generation
 592                --  gets confused by the "wrong" Sloc values put in the tree.
 593
 594                Debug_Generated_Code := True;
 595                Xref_Active := False;
 596                Set_Debug_Flag ('g');
 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                   when 'c' =>
 610                      Ptr := Ptr + 1;
 611                      if Ptr > Max then
 612                         Osint.Fail ("Invalid switch: ", "ec");
 613                      end if;
 614
 615                      Config_File_Name :=
 616                         new String'(Switch_Chars (Ptr .. Max));
 617
 618                      return;
 619
 620                   when others =>
 621                      Osint.Fail ("Invalid switch: ",
 622                                    (1 => 'e', 2 => Switch_Chars (Ptr)));
 623                end case;
 624
 625             --  Processing for E switch
 626
 627             when 'E' =>
 628                Ptr := Ptr + 1;
 629                Dynamic_Elaboration_Checks := True;
 630
 631             --  Processing for f switch
 632
 633             when 'f' =>
 634                Ptr := Ptr + 1;
 635                All_Errors_Mode := True;
 636
 637             --  Processing for F switch
 638
 639             when 'F' =>
 640                Ptr := Ptr + 1;
 641                External_Name_Exp_Casing := Uppercase;
 642                External_Name_Imp_Casing := Uppercase;
 643
 644             --  Processing for g switch
 645
 646             when 'g' =>
 647                Ptr := Ptr + 1;
 648                GNAT_Mode                := True;
 649                Identifier_Character_Set := 'n';
 650                Warning_Mode             := Treat_As_Error;
 651                Check_Unreferenced       := True;
 652                Check_Withs              := True;
 653
 654                Set_Default_Style_Check_Options;
 655
 656             --  Processing for G switch
 657
 658             when 'G' =>
 659                Ptr := Ptr + 1;
 660                Print_Generated_Code := True;
 661
 662             --  Processing for h switch
 663
 664             when 'h' =>
 665                Ptr := Ptr + 1;
 666                Usage_Requested := True;
 667
 668             --  Processing for H switch
 669
 670             when 'H' =>
 671                Ptr := Ptr + 1;
 672                HLO_Active := True;
 673
 674             --  Processing for i switch
 675
 676             when 'i' =>
 677                if Ptr = Max then
 678                   raise Bad_Switch;
 679                end if;
 680
 681                Ptr := Ptr + 1;
 682                C := Switch_Chars (Ptr);
 683
 684                if C = '1' or else
 685                   C = '2' or else
 686                   C = '3' or else
 687                   C = '4' or else
 688                   C = '8' or else
 689                   C = 'p' or else
 690                   C = 'f' or else
 691                   C = 'n' or else
 692                   C = 'w'
 693                then
 694                   Identifier_Character_Set := C;
 695                   Ptr := Ptr + 1;
 696
 697                else
 698                   raise Bad_Switch;
 699                end if;
 700
 701             --  Processing for k switch
 702
 703             when 'k' =>
 704                Ptr := Ptr + 1;
 705                Scan_Pos (Switch_Chars, Max, Ptr, Maximum_File_Name_Length);
 706
 707             --  Processing for l switch
 708
 709             when 'l' =>
 710                Ptr := Ptr + 1;
 711                Full_List := True;
 712
 713             --  Processing for L switch
 714
 715             when 'L' =>
 716                Ptr := Ptr + 1;
 717                Zero_Cost_Exceptions_Set := True;
 718                Zero_Cost_Exceptions_Val := False;
 719
 720             --  Processing for m switch
 721
 722             when 'm' =>
 723                Ptr := Ptr + 1;
 724                Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
 725
 726             --  Processing for n switch
 727
 728             when 'n' =>
 729                Ptr := Ptr + 1;
 730                Inline_Active := True;
 731
 732             --  Processing for N switch
 733
 734             when 'N' =>
 735                Ptr := Ptr + 1;
 736                Inline_Active := True;
 737                Front_End_Inlining := True;
 738
 739             --  Processing for o switch
 740
 741             when 'o' =>
 742                Ptr := Ptr + 1;
 743                Suppress_Options.Overflow_Checks := False;
 744
 745             --  Processing for O switch
 746
 747             when 'O' =>
 748                Ptr := Ptr + 1;
 749                Output_File_Name_Present := True;
 750
 751             --  Processing for p switch
 752
 753             when 'p' =>
 754                Ptr := Ptr + 1;
 755                Suppress_Options.Access_Checks        := True;
 756                Suppress_Options.Accessibility_Checks := True;
 757                Suppress_Options.Discriminant_Checks  := True;
 758                Suppress_Options.Division_Checks      := True;
 759                Suppress_Options.Elaboration_Checks   := True;
 760                Suppress_Options.Index_Checks         := True;
 761                Suppress_Options.Length_Checks        := True;
 762                Suppress_Options.Overflow_Checks      := True;
 763                Suppress_Options.Range_Checks         := True;
 764                Suppress_Options.Division_Checks      := True;
 765                Suppress_Options.Length_Checks        := True;
 766                Suppress_Options.Range_Checks         := True;
 767                Suppress_Options.Storage_Checks       := True;
 768                Suppress_Options.Tag_Checks           := True;
 769
 770                Validity_Checks_On := False;
 771
 772             --  Processing for P switch
 773
 774             when 'P' =>
 775                Ptr := Ptr + 1;
 776                Polling_Required := True;
 777
 778             --  Processing for q switch
 779
 780             when 'q' =>
 781                Ptr := Ptr + 1;
 782                Try_Semantics := True;
 783
 784             --  Processing for q switch
 785
 786             when 'Q' =>
 787                Ptr := Ptr + 1;
 788                Force_ALI_Tree_File := True;
 789                Try_Semantics := True;
 790
 791             --  Processing for r switch
 792
 793             when 'r' =>
 794                Ptr := Ptr + 1;
 795
 796                --  Temporarily allow -gnatr to mean -gnatyl (use RM layout)
 797                --  for compatibility with pre 3.12 versions of GNAT,
 798                --  to be removed for 3.13 ???
 799
 800                Set_Style_Check_Options ("l");
 801
 802             --  Processing for R switch
 803
 804             when 'R' =>
 805                Ptr := Ptr + 1;
 806                Back_Annotate_Rep_Info := True;
 807
 808                if Ptr <= Max
 809                  and then Switch_Chars (Ptr) in '0' .. '9'
 810                then
 811                   C := Switch_Chars (Ptr);
 812
 813                   if C in '4' .. '9' then
 814                      raise Bad_Switch;
 815                   else
 816                      List_Representation_Info :=
 817                        Character'Pos (C) - Character'Pos ('0');
 818                      Ptr := Ptr + 1;
 819                   end if;
 820
 821                else
 822                   List_Representation_Info := 1;
 823                end if;
 824
 825             --  Processing for s switch
 826
 827             when 's' =>
 828                Ptr := Ptr + 1;
 829                Operating_Mode := Check_Syntax;
 830
 831             --  Processing for t switch
 832
 833             when 't' =>
 834                Ptr := Ptr + 1;
 835                Tree_Output := True;
 836                Back_Annotate_Rep_Info := True;
 837
 838             --  Processing for T switch
 839
 840             when 'T' =>
 841                Ptr := Ptr + 1;
 842                Time_Slice_Set := True;
 843                Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);
 844
 845             --  Processing for u switch
 846
 847             when 'u' =>
 848                Ptr := Ptr + 1;
 849                List_Units := True;
 850
 851             --  Processing for U switch
 852
 853             when 'U' =>
 854                Ptr := Ptr + 1;
 855                Unique_Error_Tag := True;
 856
 857             --  Processing for v switch
 858
 859             when 'v' =>
 860                Ptr := Ptr + 1;
 861                Verbose_Mode := True;
 862
 863             --  Processing for V switch
 864
 865             when 'V' =>
 866                Ptr := Ptr + 1;
 867
 868                if Ptr > Max then
 869                   raise Bad_Switch;
 870
 871                else
 872                   declare
 873                      OK  : Boolean;
 874
 875                   begin
 876                      Set_Validity_Check_Options
 877                        (Switch_Chars (Ptr .. Max), OK, Ptr);
 878
 879                      if not OK then
 880                         raise Bad_Switch;
 881                      end if;
 882                   end;
 883                end if;
 884
 885             --  Processing for w switch
 886
 887             when 'w' =>
 888                Ptr := Ptr + 1;
 889
 890                if Ptr > Max then
 891                   raise Bad_Switch;
 892                end if;
 893
 894                while Ptr <= Max loop
 895                   C := Switch_Chars (Ptr);
 896
 897                   case C is
 898
 899                      when 'a' =>
 900                         Constant_Condition_Warnings  := True;
 901                         Elab_Warnings                := True;
 902                         Check_Unreferenced           := True;
 903                         Check_Withs                  := True;
 904                         Implementation_Unit_Warnings := True;
 905                         Ineffective_Inline_Warnings  := True;
 906                         Warn_On_Redundant_Constructs := True;
 907
 908                      when 'A' =>
 909                         Constant_Condition_Warnings  := False;
 910                         Elab_Warnings                := False;
 911                         Check_Unreferenced           := False;
 912                         Check_Withs                  := False;
 913                         Implementation_Unit_Warnings := False;
 914                         Warn_On_Biased_Rounding      := False;
 915                         Warn_On_Hiding               := False;
 916                         Warn_On_Redundant_Constructs := False;
 917                         Ineffective_Inline_Warnings  := False;
 918
 919                      when 'c' =>
 920                         Constant_Condition_Warnings := True;
 921
 922                      when 'C' =>
 923                         Constant_Condition_Warnings := False;
 924
 925                      when 'b' =>
 926                         Warn_On_Biased_Rounding := True;
 927
 928                      when 'B' =>
 929                         Warn_On_Biased_Rounding := False;
 930
 931                      when 'e' =>
 932                         Warning_Mode := Treat_As_Error;
 933
 934                      when 'h' =>
 935                         Warn_On_Hiding := True;
 936
 937                      when 'H' =>
 938                         Warn_On_Hiding := False;
 939
 940                      when 'i' =>
 941                         Implementation_Unit_Warnings := True;
 942
 943                      when 'I' =>
 944                         Implementation_Unit_Warnings := False;
 945
 946                      when 'l' =>
 947                         Elab_Warnings := True;
 948
 949                      when 'L' =>
 950                         Elab_Warnings := False;
 951
 952                      when 'o' =>
 953                         Address_Clause_Overlay_Warnings := True;
 954
 955                      when 'O' =>
 956                         Address_Clause_Overlay_Warnings := False;
 957
 958                      when 'p' =>
 959                         Ineffective_Inline_Warnings := True;
 960
 961                      when 'P' =>
 962                         Ineffective_Inline_Warnings := False;
 963
 964                      when 'r' =>
 965                         Warn_On_Redundant_Constructs := True;
 966
 967                      when 'R' =>
 968                         Warn_On_Redundant_Constructs := False;
 969
 970                      when 's' =>
 971                         Warning_Mode  := Suppress;
 972
 973                      when 'u' =>
 974                         Check_Unreferenced := True;
 975                         Check_Withs        := True;
 976
 977                      when 'U' =>
 978                         Check_Unreferenced := False;
 979                         Check_Withs        := False;
 980
 981                         --  Allow and ignore 'w' so that the old
 982                         --  format (e.g. -gnatwuwl) will work.
 983
 984                      when 'w' =>
 985                         null;
 986
 987                      when others =>
 988                         raise Bad_Switch;
 989                   end case;
 990
 991                   Ptr := Ptr + 1;
 992                end loop;
 993
 994                return;
 995
 996             --  Processing for W switch
 997
 998             when 'W' =>
 999                Ptr := Ptr + 1;
1000
1001                for J in WC_Encoding_Method loop
1002                   if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
1003                      Wide_Character_Encoding_Method := J;
1004                      exit;
1005
1006                   elsif J = WC_Encoding_Method'Last then
1007                      raise Bad_Switch;
1008                   end if;
1009                end loop;
1010
1011                Upper_Half_Encoding :=
1012                  Wide_Character_Encoding_Method in
1013                  WC_Upper_Half_Encoding_Method;
1014
1015                Ptr := Ptr + 1;
1016
1017             --  Processing for x switch
1018
1019             when 'x' =>
1020                Ptr := Ptr + 1;
1021                Xref_Active := False;
1022
1023             --  Processing for X switch
1024
1025             when 'X' =>
1026                Ptr := Ptr + 1;
1027                Extensions_Allowed := True;
1028
1029             --  Processing for y switch
1030
1031             when 'y' =>
1032                Ptr := Ptr + 1;
1033
1034                if Ptr > Max then
1035                   Set_Default_Style_Check_Options;
1036
1037                else
1038                   declare
1039                      OK  : Boolean;
1040
1041                   begin
1042                      Set_Style_Check_Options
1043                        (Switch_Chars (Ptr .. Max), OK, Ptr);
1044
1045                      if not OK then
1046                         raise Bad_Switch;
1047                      end if;
1048                   end;
1049                end if;
1050
1051             --  Processing for z switch
1052
1053             when 'z' =>
1054                Ptr := Ptr + 1;
1055
1056                --  Allowed for compiler, only if this is the only
1057                --  -z switch, we do not allow multiple occurrences
1058
1059                if Distribution_Stub_Mode = No_Stubs then
1060                   case Switch_Chars (Ptr) is
1061                      when 'r' =>
1062                         Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
1063
1064                      when 'c' =>
1065                         Distribution_Stub_Mode := Generate_Caller_Stub_Body;
1066
1067                      when others =>
1068                         raise Bad_Switch;
1069                   end case;
1070
1071                   Ptr := Ptr + 1;
1072
1073                end if;
1074
1075             --  Processing for Z switch
1076
1077             when 'Z' =>
1078                Ptr := Ptr + 1;
1079                Zero_Cost_Exceptions_Set := True;
1080                Zero_Cost_Exceptions_Val := True;
1081
1082             --  Processing for 83 switch
1083
1084             when '8' =>
1085
1086                if Ptr = Max then
1087                   raise Bad_Switch;
1088                end if;
1089
1090                Ptr := Ptr + 1;
1091
1092                if Switch_Chars (Ptr) /= '3' then
1093                   raise Bad_Switch;
1094                else
1095                   Ptr := Ptr + 1;
1096                   Ada_95 := False;
1097                   Ada_83 := True;
1098                end if;
1099
1100             --  Ignore extra switch character
1101
1102             when '/' | '-' =>
1103                Ptr := Ptr + 1;
1104
1105             --  Anything else is an error (illegal switch character)
1106
1107             when others =>
1108                raise Bad_Switch;
1109             end case;
1110          end case;
1111       end loop;
1112
1113    exception
1114       when Bad_Switch =>
1115          Osint.Fail ("invalid switch: ", (1 => C));
1116
1117       when Bad_Switch_Value =>
1118          Osint.Fail ("numeric value too big for switch: ", (1 => C));
1119
1120       when Missing_Switch_Value =>
1121          Osint.Fail ("missing numeric value for switch: ", (1 => C));
1122
1123    end Scan_Front_End_Switches;
1124
1125    ------------------------
1126    -- Scan_Make_Switches --
1127    ------------------------
1128
1129    procedure Scan_Make_Switches (Switch_Chars : String) is
1130       Ptr : Integer := Switch_Chars'First;
1131       Max : Integer := Switch_Chars'Last;
1132       C   : Character := ' ';
1133
1134    begin
1135       --  Skip past the initial character (must be the switch character)
1136
1137       if Ptr = Max then
1138          raise Bad_Switch;
1139
1140       else
1141          Ptr := Ptr + 1;
1142       end if;
1143
1144       --  A little check, "gnat" at the start of a switch is not allowed
1145       --  except for the compiler (where it was already removed)
1146
1147       if Switch_Chars'Length >= Ptr + 3
1148         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
1149       then
1150          Osint.Fail
1151            ("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
1152       end if;
1153
1154       --  Loop to scan through switches given in switch string
1155
1156       while Ptr <= Max loop
1157          C := Switch_Chars (Ptr);
1158
1159          --  Processing for a switch
1160
1161          case C is
1162
1163          when 'a' =>
1164             Ptr := Ptr + 1;
1165             Check_Readonly_Files := True;
1166
1167          --  Processing for c switch
1168
1169          when 'c' =>
1170             Ptr := Ptr + 1;
1171             Compile_Only := True;
1172
1173          when 'd' =>
1174
1175             --  Note: for the debug switch, the remaining characters in this
1176             --  switch field must all be debug flags, since all valid switch
1177             --  characters are also valid debug characters.
1178
1179             --  Loop to scan out debug flags
1180
1181             while Ptr < Max loop
1182                Ptr := Ptr + 1;
1183                C := Switch_Chars (Ptr);
1184                exit when C = ASCII.NUL or else C = '/' or else C = '-';
1185
1186                if C in '1' .. '9' or else
1187                   C in 'a' .. 'z' or else
1188                   C in 'A' .. 'Z'
1189                then
1190                   Set_Debug_Flag (C);
1191                else
1192                   raise Bad_Switch;
1193                end if;
1194             end loop;
1195
1196             --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
1197             --  is for backwards compatibility with old versions and usage.
1198
1199             if Debug_Flag_XX then
1200                Zero_Cost_Exceptions_Set := True;
1201                Zero_Cost_Exceptions_Val := True;
1202             end if;
1203
1204             return;
1205
1206          --  Processing for f switch
1207
1208          when 'f' =>
1209             Ptr := Ptr + 1;
1210             Force_Compilations := True;
1211
1212          --  Processing for G switch
1213
1214          when 'G' =>
1215             Ptr := Ptr + 1;
1216             Print_Generated_Code := True;
1217
1218          --  Processing for h switch
1219
1220          when 'h' =>
1221             Ptr := Ptr + 1;
1222             Usage_Requested := True;
1223
1224          --  Processing for i switch
1225
1226          when 'i' =>
1227             Ptr := Ptr + 1;
1228             In_Place_Mode := True;
1229
1230          --  Processing for j switch
1231
1232          when 'j' =>
1233             Ptr := Ptr + 1;
1234
1235             declare
1236                Max_Proc : Pos;
1237             begin
1238                Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc);
1239                Maximum_Processes := Positive (Max_Proc);
1240             end;
1241
1242          --  Processing for k switch
1243
1244          when 'k' =>
1245             Ptr := Ptr + 1;
1246             Keep_Going := True;
1247
1248          when 'M' =>
1249             Ptr := Ptr + 1;
1250             List_Dependencies := True;
1251
1252          --  Processing for n switch
1253
1254          when 'n' =>
1255             Ptr := Ptr + 1;
1256             Do_Not_Execute := True;
1257
1258          --  Processing for o switch
1259
1260          when 'o' =>
1261             Ptr := Ptr + 1;
1262
1263             if Output_File_Name_Present then
1264                raise Too_Many_Output_Files;
1265             else
1266                Output_File_Name_Present := True;
1267             end if;
1268
1269          --  Processing for q switch
1270
1271          when 'q' =>
1272             Ptr := Ptr + 1;
1273             Quiet_Output := True;
1274
1275          --  Processing for s switch
1276
1277          when 's' =>
1278             Ptr := Ptr + 1;
1279             Check_Switches := True;
1280
1281          --  Processing for v switch
1282
1283          when 'v' =>
1284             Ptr := Ptr + 1;
1285             Verbose_Mode := True;
1286
1287          --  Processing for z switch
1288
1289          when 'z' =>
1290             Ptr := Ptr + 1;
1291             No_Main_Subprogram := True;
1292
1293          --  Ignore extra switch character
1294
1295          when '/' | '-' =>
1296             Ptr := Ptr + 1;
1297
1298          --  Anything else is an error (illegal switch character)
1299
1300          when others =>
1301             raise Bad_Switch;
1302
1303          end case;
1304       end loop;
1305
1306    exception
1307       when Bad_Switch =>
1308          Osint.Fail ("invalid switch: ", (1 => C));
1309
1310       when Bad_Switch_Value =>
1311          Osint.Fail ("numeric value too big for switch: ", (1 => C));
1312
1313       when Missing_Switch_Value =>
1314          Osint.Fail ("missing numeric value for switch: ", (1 => C));
1315
1316       when Too_Many_Output_Files =>
1317          Osint.Fail ("duplicate -o switch");
1318
1319    end Scan_Make_Switches;
1320
1321    --------------
1322    -- Scan_Nat --
1323    --------------
1324
1325    procedure Scan_Nat
1326      (Switch_Chars : String;
1327       Max          : Integer;
1328       Ptr          : in out Integer;
1329       Result       : out Nat) is
1330    begin
1331       Result := 0;
1332       if Ptr > Max or else Switch_Chars (Ptr) not in '0' .. '9' then
1333          raise Missing_Switch_Value;
1334       end if;
1335
1336       while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop
1337          Result := Result * 10 +
1338            Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0');
1339          Ptr := Ptr + 1;
1340
1341          if Result > Switch_Max_Value then
1342             raise Bad_Switch_Value;
1343          end if;
1344       end loop;
1345    end Scan_Nat;
1346
1347    --------------
1348    -- Scan_Pos --
1349    --------------
1350
1351    procedure Scan_Pos
1352      (Switch_Chars : String;
1353       Max          : Integer;
1354       Ptr          : in out Integer;
1355       Result       : out Pos) is
1356
1357    begin
1358       Scan_Nat (Switch_Chars, Max, Ptr, Result);
1359       if Result = 0 then
1360          raise Bad_Switch_Value;
1361       end if;
1362    end Scan_Pos;
1363
1364 end Switch;