gcc/ada/switch-b.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S W I T C H - B                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2020, 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 with Bindgen;
  27 with Debug;  use Debug;
  28 with Osint;  use Osint;
  29 with Opt;    use Opt;
  30
  31 with System.OS_Lib;  use System.OS_Lib;
  32 with System.WCh_Con; use System.WCh_Con;
  33
  34 package body Switch.B is
  35
  36    --------------------------
  37    -- Scan_Binder_Switches --
  38    --------------------------
  39
  40    procedure Scan_Binder_Switches (Switch_Chars : String) is
  41       Max : constant Integer := Switch_Chars'Last;
  42       Ptr : Integer          := Switch_Chars'First;
  43       C   : Character        := ' ';
  44
  45       function Get_Optional_Filename return String_Ptr;
  46       --  If current character is '=', return a newly allocated string that
  47       --  contains the remainder of the current switch (after the '='), else
  48       --  return null.
  49
  50       function Get_Stack_Size (S : Character) return Int;
  51       --  Used for -d and -D to scan stack size including handling k/m. S is
  52       --  set to 'd' or 'D' to indicate the switch being scanned.
  53
  54       procedure Scan_Debug_Switches;
  55       --  Scan out debug switches
  56
  57       ---------------------------
  58       -- Get_Optional_Filename --
  59       ---------------------------
  60
  61       function Get_Optional_Filename return String_Ptr is
  62          Result : String_Ptr;
  63
  64       begin
  65          if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
  66             if Ptr = Max then
  67                Bad_Switch (Switch_Chars);
  68             else
  69                Result := new String'(Switch_Chars (Ptr + 1 .. Max));
  70                Ptr := Max + 1;
  71                return Result;
  72             end if;
  73          end if;
  74
  75          return null;
  76       end Get_Optional_Filename;
  77
  78       --------------------
  79       -- Get_Stack_Size --
  80       --------------------
  81
  82       function Get_Stack_Size (S : Character) return Int is
  83          Result : Int;
  84
  85       begin
  86          Scan_Pos (Switch_Chars, Max, Ptr, Result, S);
  87
  88          --  In the following code, we enable overflow checking since the
  89          --  multiplication by K or M may cause overflow, which is an error.
  90
  91          declare
  92             pragma Unsuppress (Overflow_Check);
  93
  94          begin
  95             --  Check for additional character 'k' (for kilobytes) or 'm' (for
  96             --  Megabytes), but only if we have not reached the end of the
  97             --  switch string. Note that if this appears before the end of the
  98             --  string we will get an error when we test to make sure that the
  99             --  string is exhausted (at the end of the case).
 100
 101             if Ptr <= Max then
 102                if Switch_Chars (Ptr) = 'k' then
 103                   Result := Result * 1024;
 104                   Ptr := Ptr + 1;
 105
 106                elsif Switch_Chars (Ptr) = 'm' then
 107                   Result := Result * (1024 * 1024);
 108                   Ptr := Ptr + 1;
 109                end if;
 110             end if;
 111
 112          exception
 113             when Constraint_Error =>
 114                Osint.Fail ("numeric value out of range for switch: " & S);
 115          end;
 116
 117          return Result;
 118       end Get_Stack_Size;
 119
 120       -------------------------
 121       -- Scan_Debug_Switches --
 122       -------------------------
 123
 124       procedure Scan_Debug_Switches is
 125          Dot        : Boolean := False;
 126          Underscore : Boolean := False;
 127
 128       begin
 129          while Ptr <= Max loop
 130             C := Switch_Chars (Ptr);
 131
 132             --  Binder debug flags come in the following forms:
 133             --
 134             --       letter
 135             --     . letter
 136             --     _ letter
 137             --
 138             --       digit
 139             --     . digit
 140             --     _ digit
 141             --
 142             --  Note that the processing of switch -d aleady takes care of the
 143             --  case where the first flag is a digit (default stack size).
 144
 145             if C in '1' .. '9' or else
 146                C in 'a' .. 'z' or else
 147                C in 'A' .. 'Z'
 148             then
 149                --  . letter
 150                --  . digit
 151
 152                if Dot then
 153                   Set_Dotted_Debug_Flag (C);
 154                   Dot := False;
 155
 156                --  _ letter
 157                --  _ digit
 158
 159                elsif Underscore then
 160                   Set_Underscored_Debug_Flag (C);
 161                   Underscore := False;
 162
 163                --    letter
 164                --    digit
 165
 166                else
 167                   Set_Debug_Flag (C);
 168                end if;
 169
 170             elsif C = '.' then
 171                Dot := True;
 172
 173             elsif C = '_' then
 174                Underscore := True;
 175
 176             else
 177                Bad_Switch (Switch_Chars);
 178             end if;
 179
 180             Ptr := Ptr + 1;
 181          end loop;
 182       end Scan_Debug_Switches;
 183
 184    --  Start of processing for Scan_Binder_Switches
 185
 186    begin
 187       --  Skip past the initial character (must be the switch character)
 188
 189       if Ptr = Max then
 190          Bad_Switch (Switch_Chars);
 191       else
 192          Ptr := Ptr + 1;
 193       end if;
 194
 195       --  A little check, "gnat" at the start of a switch is not allowed except
 196       --  for the compiler
 197
 198       if Max >= Ptr + 3
 199         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
 200       then
 201          Osint.Fail ("invalid switch: """ & Switch_Chars & """"
 202                      & " (gnat not needed here)");
 203       end if;
 204
 205       --  Loop to scan through switches given in switch string
 206
 207       Check_Switch : begin
 208          C := Switch_Chars (Ptr);
 209
 210          case C is
 211
 212          --  Processing for a switch
 213
 214          when 'a' =>
 215             Ptr := Ptr + 1;
 216             Use_Pragma_Linker_Constructor := True;
 217
 218          --  Processing for A switch
 219
 220          when 'A' =>
 221             Ptr := Ptr + 1;
 222             Output_ALI_List := True;
 223             ALI_List_Filename := Get_Optional_Filename;
 224
 225          --  Processing for b switch
 226
 227          when 'b' =>
 228             Ptr := Ptr + 1;
 229             Brief_Output := True;
 230
 231          --  Processing for c switch
 232
 233          when 'c' =>
 234             Ptr := Ptr + 1;
 235             Check_Only := True;
 236
 237          --  Processing for d switch
 238
 239          when 'd' =>
 240             if Ptr = Max then
 241                Bad_Switch (Switch_Chars);
 242             end if;
 243
 244             Ptr := Ptr + 1;
 245             C := Switch_Chars (Ptr);
 246
 247             --  Case where character after -d is a digit (default stack size)
 248
 249             if C in '0' .. '9' then
 250
 251                --  In this case, we process the default primary stack size
 252
 253                Default_Stack_Size := Get_Stack_Size ('d');
 254
 255             --  Case where character after -d is not digit (debug flags)
 256
 257             else
 258                Scan_Debug_Switches;
 259             end if;
 260
 261          --  Processing for D switch
 262
 263          when 'D' =>
 264             if Ptr = Max then
 265                Bad_Switch (Switch_Chars);
 266             end if;
 267
 268             Ptr := Ptr + 1;
 269             Default_Sec_Stack_Size := Get_Stack_Size ('D');
 270
 271          --  Processing for e switch
 272
 273          when 'e' =>
 274             Ptr := Ptr + 1;
 275             Elab_Dependency_Output := True;
 276
 277          --  Processing for E switch
 278
 279          when 'E' =>
 280
 281             --  -E is equivalent to -Ea (see below)
 282
 283             Exception_Tracebacks := True;
 284             Ptr := Ptr + 1;
 285
 286             if Ptr <= Max then
 287                case Switch_Chars (Ptr) is
 288
 289                   --  -Ea sets Exception_Tracebacks
 290
 291                   when 'a' => null;
 292
 293                   --  -Es sets both Exception_Tracebacks and
 294                   --  Exception_Tracebacks_Symbolic.
 295
 296                   when 's' => Exception_Tracebacks_Symbolic := True;
 297                   when others => Bad_Switch (Switch_Chars);
 298                end case;
 299
 300                Ptr := Ptr + 1;
 301             end if;
 302
 303          --  Processing for f switch
 304
 305          when 'f' =>
 306             if Ptr = Max then
 307                Bad_Switch (Switch_Chars);
 308             end if;
 309
 310             Force_Elab_Order_File :=
 311               new String'(Switch_Chars (Ptr + 1 .. Max));
 312
 313             Ptr := Max + 1;
 314
 315             if not Is_Read_Accessible_File (Force_Elab_Order_File.all) then
 316                Osint.Fail (Force_Elab_Order_File.all & ": file not found");
 317             end if;
 318
 319          --  Processing for F switch
 320
 321          when 'F' =>
 322             Ptr := Ptr + 1;
 323             Force_Checking_Of_Elaboration_Flags := True;
 324
 325          --  Processing for g switch
 326
 327          when 'g' =>
 328             Ptr := Ptr + 1;
 329
 330             if Ptr <= Max then
 331                C := Switch_Chars (Ptr);
 332
 333                if C in '0' .. '3' then
 334                   Debugger_Level :=
 335                     Character'Pos
 336                       (Switch_Chars (Ptr)) - Character'Pos ('0');
 337                   Ptr := Ptr + 1;
 338                end if;
 339
 340             else
 341                Debugger_Level := 2;
 342             end if;
 343
 344          --  Processing for G switch
 345
 346          when 'G' =>
 347             Ptr := Ptr + 1;
 348             Generate_C_Code := True;
 349
 350          --  Processing for h switch
 351
 352          when 'h' =>
 353             Ptr := Ptr + 1;
 354             Usage_Requested := True;
 355
 356          --  Processing for H switch
 357
 358          when 'H' =>
 359             Ptr := Ptr + 1;
 360             Legacy_Elaboration_Order := True;
 361
 362          --  Processing for i switch
 363
 364          when 'i' =>
 365             if Ptr = Max then
 366                Bad_Switch (Switch_Chars);
 367             end if;
 368
 369             Ptr := Ptr + 1;
 370             C := Switch_Chars (Ptr);
 371
 372             if C in '1' .. '5'
 373               or else C = '8'
 374               or else C = 'p'
 375               or else C = 'f'
 376               or else C = 'n'
 377               or else C = 'w'
 378             then
 379                Identifier_Character_Set := C;
 380                Ptr := Ptr + 1;
 381             else
 382                Bad_Switch (Switch_Chars);
 383             end if;
 384
 385          --  Processing for K switch
 386
 387          when 'K' =>
 388             Ptr := Ptr + 1;
 389             Output_Linker_Option_List := True;
 390
 391          --  Processing for l switch
 392
 393          when 'l' =>
 394             Ptr := Ptr + 1;
 395             Elab_Order_Output := True;
 396
 397          --  Processing for m switch
 398
 399          when 'm' =>
 400             if Ptr = Max then
 401                Bad_Switch (Switch_Chars);
 402             end if;
 403
 404             Ptr := Ptr + 1;
 405             Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Messages, C);
 406
 407          --  Processing for n switch
 408
 409          when 'n' =>
 410             Ptr := Ptr + 1;
 411             Bind_Main_Program := False;
 412
 413             --  Note: The -L option of the binder also implies -n, so
 414             --  any change here must also be reflected in the processing
 415             --  for -L that is found in Gnatbind.Scan_Bind_Arg.
 416
 417          --  Processing for o switch
 418
 419          when 'o' =>
 420             Ptr := Ptr + 1;
 421
 422             if Output_File_Name_Present then
 423                Osint.Fail ("duplicate -o switch");
 424             else
 425                Output_File_Name_Present := True;
 426             end if;
 427
 428          --  Processing for O switch
 429
 430          when 'O' =>
 431             Ptr := Ptr + 1;
 432             Output_Object_List := True;
 433             Object_List_Filename := Get_Optional_Filename;
 434
 435          --  Processing for p switch
 436
 437          when 'p' =>
 438             Ptr := Ptr + 1;
 439             Pessimistic_Elab_Order := True;
 440
 441          --  Processing for P switch
 442
 443          when 'P' =>
 444             Ptr := Ptr + 1;
 445             CodePeer_Mode := True;
 446
 447          --  Processing for q switch
 448
 449          when 'q' =>
 450             Ptr := Ptr + 1;
 451             Quiet_Output := True;
 452
 453          --  Processing for Q switch
 454
 455          when 'Q' =>
 456             if Ptr = Max then
 457                Bad_Switch (Switch_Chars);
 458             end if;
 459
 460             Ptr := Ptr + 1;
 461             Scan_Nat
 462               (Switch_Chars, Max, Ptr,
 463                Quantity_Of_Default_Size_Sec_Stacks, C);
 464
 465          --  Processing for r switch
 466
 467          when 'r' =>
 468             Ptr := Ptr + 1;
 469             List_Restrictions := True;
 470
 471          --  Processing for R switch
 472
 473          when 'R' =>
 474             Ptr := Ptr + 1;
 475             List_Closure := True;
 476
 477             if Ptr <= Max and then Switch_Chars (Ptr) = 'a' then
 478                Ptr := Ptr + 1;
 479                List_Closure_All := True;
 480             end if;
 481
 482          --  Processing for s switch
 483
 484          when 's' =>
 485             Ptr := Ptr + 1;
 486             All_Sources := True;
 487             Check_Source_Files := True;
 488
 489          --  Processing for t switch
 490
 491          when 't' =>
 492             Ptr := Ptr + 1;
 493             Tolerate_Consistency_Errors := True;
 494
 495          --  Processing for T switch
 496
 497          when 'T' =>
 498             if Ptr = Max then
 499                Bad_Switch (Switch_Chars);
 500             end if;
 501
 502             Ptr := Ptr + 1;
 503             Time_Slice_Set := True;
 504             Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value, C);
 505             Time_Slice_Value := Time_Slice_Value * 1_000;
 506
 507          --  Processing for u switch
 508
 509          when 'u' =>
 510             if Ptr = Max then
 511                Bad_Switch (Switch_Chars);
 512             end if;
 513
 514             Ptr := Ptr + 1;
 515             Dynamic_Stack_Measurement := True;
 516             Scan_Nat
 517               (Switch_Chars,
 518                Max,
 519                Ptr,
 520                Dynamic_Stack_Measurement_Array_Size,
 521                C);
 522
 523          --  Processing for v switch
 524
 525          when 'v' =>
 526             Ptr := Ptr + 1;
 527             Verbose_Mode := True;
 528
 529          --  Processing for V switch
 530
 531          when 'V' =>
 532             declare
 533                Eq : Integer;
 534             begin
 535                Ptr := Ptr + 1;
 536                Eq := Ptr;
 537                while Eq <= Max and then Switch_Chars (Eq) /= '=' loop
 538                   Eq := Eq + 1;
 539                end loop;
 540                if Eq = Ptr or else Eq = Max then
 541                   Bad_Switch (Switch_Chars);
 542                end if;
 543                Bindgen.Set_Bind_Env
 544                  (Key   => Switch_Chars (Ptr .. Eq - 1),
 545                   Value => Switch_Chars (Eq + 1 .. Max));
 546                Ptr := Max + 1;
 547             end;
 548
 549          --  Processing for w switch
 550
 551          when 'w' =>
 552             if Ptr = Max then
 553                Bad_Switch (Switch_Chars);
 554             end if;
 555
 556             --  For the binder we only allow suppress/error cases
 557
 558             Ptr := Ptr + 1;
 559
 560             case Switch_Chars (Ptr) is
 561                when 'e' =>
 562                   Warning_Mode := Treat_As_Error;
 563
 564                when 'E' =>
 565                   Warning_Mode := Treat_Run_Time_Warnings_As_Errors;
 566
 567                when 's' =>
 568                   Warning_Mode := Suppress;
 569
 570                when others =>
 571                   Bad_Switch (Switch_Chars);
 572             end case;
 573
 574             Ptr := Ptr + 1;
 575
 576          --  Processing for W switch
 577
 578          when 'W' =>
 579             Ptr := Ptr + 1;
 580
 581             if Ptr > Max then
 582                Bad_Switch (Switch_Chars);
 583             end if;
 584
 585             begin
 586                Wide_Character_Encoding_Method :=
 587                  Get_WC_Encoding_Method (Switch_Chars (Ptr));
 588             exception
 589                when Constraint_Error =>
 590                   Bad_Switch (Switch_Chars);
 591             end;
 592
 593             Wide_Character_Encoding_Method_Specified := True;
 594
 595             Upper_Half_Encoding :=
 596               Wide_Character_Encoding_Method in WC_Upper_Half_Encoding_Method;
 597
 598             Ptr := Ptr + 1;
 599
 600          --  Processing for x switch
 601
 602          when 'x' =>
 603             Ptr := Ptr + 1;
 604             All_Sources := False;
 605             Check_Source_Files := False;
 606
 607          --  Processing for X switch
 608
 609          when 'X' =>
 610             if Ptr = Max then
 611                Bad_Switch (Switch_Chars);
 612             end if;
 613
 614             Ptr := Ptr + 1;
 615             Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status, C);
 616
 617          --  Processing for y switch
 618
 619          when 'y' =>
 620             Ptr := Ptr + 1;
 621             Leap_Seconds_Support := True;
 622
 623          --  Processing for z switch
 624
 625          when 'z' =>
 626             Ptr := Ptr + 1;
 627             No_Main_Subprogram := True;
 628
 629          --  Processing for Z switch
 630
 631          when 'Z' =>
 632             Ptr := Ptr + 1;
 633             Zero_Formatting := True;
 634
 635          --  Processing for --RTS
 636
 637          when '-' =>
 638
 639             if Ptr + 4 <= Max and then
 640               Switch_Chars (Ptr + 1 .. Ptr + 3) = "RTS"
 641             then
 642                Ptr := Ptr + 4;
 643
 644                if Switch_Chars (Ptr) /= '=' or else Ptr = Max then
 645                   Osint.Fail ("missing path for --RTS");
 646
 647                else
 648                   --  Valid --RTS switch
 649
 650                   Opt.No_Stdinc := True;
 651                   Opt.RTS_Switch := True;
 652
 653                   declare
 654                      Src_Path_Name : constant String_Ptr :=
 655                                        Get_RTS_Search_Dir
 656                                          (Switch_Chars (Ptr + 1 .. Max),
 657                                           Include);
 658                      Lib_Path_Name : constant String_Ptr :=
 659                                        Get_RTS_Search_Dir
 660                                          (Switch_Chars (Ptr + 1 .. Max),
 661                                           Objects);
 662
 663                   begin
 664                      if Src_Path_Name /= null and then
 665                        Lib_Path_Name /= null
 666                      then
 667                         --  Set the RTS_*_Path_Name variables, so that the
 668                         --  correct directories will be set when a subsequent
 669                         --  call Osint.Add_Default_Search_Dirs is made.
 670
 671                         RTS_Src_Path_Name := Src_Path_Name;
 672                         RTS_Lib_Path_Name := Lib_Path_Name;
 673
 674                         Ptr := Max + 1;
 675
 676                      elsif Src_Path_Name = null
 677                        and then Lib_Path_Name = null
 678                      then
 679                         Osint.Fail
 680                           ("RTS path not valid: missing adainclude and "
 681                            & "adalib directories");
 682                      elsif Src_Path_Name = null then
 683                         Osint.Fail
 684                           ("RTS path not valid: missing adainclude directory");
 685                      elsif Lib_Path_Name = null then
 686                         Osint.Fail
 687                           ("RTS path not valid: missing adalib directory");
 688                      end if;
 689                   end;
 690                end if;
 691
 692             else
 693                Bad_Switch (Switch_Chars);
 694             end if;
 695
 696          --  Anything else is an error (illegal switch character)
 697
 698          when others =>
 699             Bad_Switch (Switch_Chars);
 700          end case;
 701
 702          if Ptr <= Max then
 703             Bad_Switch (Switch_Chars);
 704          end if;
 705       end Check_Switch;
 706    end Scan_Binder_Switches;
 707
 708 end Switch.B;