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-2023, 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
 162                   if Debug_Flag_Underscore_C then
 163                      Enable_CUDA_Expansion := True;
 164                   end if;
 165                   if Debug_Flag_Underscore_D then
 166                      Enable_CUDA_Device_Expansion := True;
 167                   end if;
 168                   if Enable_CUDA_Expansion and Enable_CUDA_Device_Expansion
 169                   then
 170                      Bad_Switch (Switch_Chars);
 171                   elsif C = 'c' then
 172                      --  specify device library name
 173                      if Ptr >= Max or else Switch_Chars (Ptr + 1) /= '=' then
 174                         Bad_Switch (Switch_Chars);
 175                      else
 176                         CUDA_Device_Library_Name :=
 177                            new String'(Switch_Chars (Ptr + 2 .. Max));
 178                         Ptr := Max;
 179                      end if;
 180                   end if;
 181
 182                   Underscore := False;
 183
 184                --    letter
 185                --    digit
 186
 187                else
 188                   Set_Debug_Flag (C);
 189                end if;
 190
 191             elsif C = '.' then
 192                Dot := True;
 193
 194             elsif C = '_' then
 195                Underscore := True;
 196
 197             else
 198                Bad_Switch (Switch_Chars);
 199             end if;
 200
 201             Ptr := Ptr + 1;
 202          end loop;
 203       end Scan_Debug_Switches;
 204
 205    --  Start of processing for Scan_Binder_Switches
 206
 207    begin
 208       --  Skip past the initial character (must be the switch character)
 209
 210       if Ptr = Max then
 211          Bad_Switch (Switch_Chars);
 212       else
 213          Ptr := Ptr + 1;
 214       end if;
 215
 216       --  A little check, "gnat" at the start of a switch is not allowed except
 217       --  for the compiler
 218
 219       if Max >= Ptr + 3
 220         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
 221       then
 222          Osint.Fail ("invalid switch: """ & Switch_Chars & """"
 223                      & " (gnat not needed here)");
 224       end if;
 225
 226       --  Loop to scan through switches given in switch string
 227
 228       Check_Switch : begin
 229          C := Switch_Chars (Ptr);
 230
 231          case C is
 232
 233          --  Processing for a switch
 234
 235          when 'a' =>
 236             Ptr := Ptr + 1;
 237             Use_Pragma_Linker_Constructor := True;
 238
 239          --  Processing for A switch
 240
 241          when 'A' =>
 242             Ptr := Ptr + 1;
 243             Output_ALI_List := True;
 244             ALI_List_Filename := Get_Optional_Filename;
 245
 246          --  Processing for b switch
 247
 248          when 'b' =>
 249             Ptr := Ptr + 1;
 250             Brief_Output := True;
 251
 252          --  Processing for c switch
 253
 254          when 'c' =>
 255             Ptr := Ptr + 1;
 256             Check_Only := True;
 257
 258          --  Processing for d switch
 259
 260          when 'd' =>
 261             if Ptr = Max then
 262                Bad_Switch (Switch_Chars);
 263             end if;
 264
 265             Ptr := Ptr + 1;
 266             C := Switch_Chars (Ptr);
 267
 268             --  Case where character after -d is a digit (default stack size)
 269
 270             if C in '0' .. '9' then
 271
 272                --  In this case, we process the default primary stack size
 273
 274                Default_Stack_Size := Get_Stack_Size ('d');
 275
 276             --  Case where character after -d is not digit (debug flags)
 277
 278             else
 279                Scan_Debug_Switches;
 280             end if;
 281
 282          --  Processing for D switch
 283
 284          when 'D' =>
 285             if Ptr = Max then
 286                Bad_Switch (Switch_Chars);
 287             end if;
 288
 289             Ptr := Ptr + 1;
 290             Default_Sec_Stack_Size := Get_Stack_Size ('D');
 291
 292          --  Processing for e switch
 293
 294          when 'e' =>
 295             Ptr := Ptr + 1;
 296             Elab_Dependency_Output := True;
 297
 298          --  Processing for E switch
 299
 300          when 'E' =>
 301
 302             --  -E is equivalent to -Ea (see below)
 303
 304             Exception_Tracebacks := True;
 305             Ptr := Ptr + 1;
 306
 307             if Ptr <= Max then
 308                case Switch_Chars (Ptr) is
 309
 310                   --  -Ea sets Exception_Tracebacks
 311
 312                   when 'a' => null;
 313
 314                   --  -Es sets both Exception_Tracebacks and
 315                   --  Exception_Tracebacks_Symbolic.
 316
 317                   when 's' => Exception_Tracebacks_Symbolic := True;
 318                   when others => Bad_Switch (Switch_Chars);
 319                end case;
 320
 321                Ptr := Ptr + 1;
 322             end if;
 323
 324          --  Processing for f switch
 325
 326          when 'f' =>
 327             if Ptr = Max then
 328                Bad_Switch (Switch_Chars);
 329             end if;
 330
 331             Force_Elab_Order_File :=
 332               new String'(Switch_Chars (Ptr + 1 .. Max));
 333
 334             Ptr := Max + 1;
 335
 336             if not Is_Regular_File (Force_Elab_Order_File.all) then
 337                Osint.Fail (Force_Elab_Order_File.all & ": file not found");
 338             end if;
 339
 340          --  Processing for F switch
 341
 342          when 'F' =>
 343             Ptr := Ptr + 1;
 344             Force_Checking_Of_Elaboration_Flags := True;
 345
 346          --  Processing for g switch
 347
 348          when 'g' =>
 349             Ptr := Ptr + 1;
 350
 351             if Ptr <= Max then
 352                C := Switch_Chars (Ptr);
 353
 354                if C in '0' .. '3' then
 355                   Debugger_Level :=
 356                     Character'Pos
 357                       (Switch_Chars (Ptr)) - Character'Pos ('0');
 358                   Ptr := Ptr + 1;
 359                end if;
 360
 361             else
 362                Debugger_Level := 2;
 363             end if;
 364
 365          --  Processing for G switch
 366
 367          when 'G' =>
 368             Ptr := Ptr + 1;
 369             Generate_C_Code := True;
 370
 371          --  Processing for h switch
 372
 373          when 'h' =>
 374             Ptr := Ptr + 1;
 375             Usage_Requested := True;
 376
 377          --  Processing for H switch
 378
 379          when 'H' =>
 380             Ptr := Ptr + 1;
 381             Legacy_Elaboration_Order := True;
 382
 383          --  Processing for i switch
 384
 385          when 'i' =>
 386             if Ptr = Max then
 387                Bad_Switch (Switch_Chars);
 388             end if;
 389
 390             Ptr := Ptr + 1;
 391             C := Switch_Chars (Ptr);
 392
 393             if C in '1' .. '5' | '9' | 'p' | '8' | 'f' | 'n' | 'w' then
 394                Identifier_Character_Set := C;
 395                Ptr := Ptr + 1;
 396             else
 397                Bad_Switch (Switch_Chars);
 398             end if;
 399
 400          --  Processing for k switch
 401
 402          when 'k' =>
 403             Ptr := Ptr + 1;
 404             Check_Elaboration_Flags := False;
 405
 406          --  Processing for K switch
 407
 408          when 'K' =>
 409             Ptr := Ptr + 1;
 410             Output_Linker_Option_List := True;
 411
 412          --  Processing for l switch
 413
 414          when 'l' =>
 415             Ptr := Ptr + 1;
 416             Elab_Order_Output := True;
 417
 418          --  Processing for m switch
 419
 420          when 'm' =>
 421             if Ptr = Max then
 422                Bad_Switch (Switch_Chars);
 423             end if;
 424
 425             Ptr := Ptr + 1;
 426             Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Messages, C);
 427
 428          --  Processing for n switch
 429
 430          when 'n' =>
 431             Ptr := Ptr + 1;
 432             Bind_Main_Program := False;
 433
 434             --  Note: The -L option of the binder also implies -n, so
 435             --  any change here must also be reflected in the processing
 436             --  for -L that is found in Gnatbind.Scan_Bind_Arg.
 437
 438          --  Processing for o switch
 439
 440          when 'o' =>
 441             Ptr := Ptr + 1;
 442
 443             if Output_File_Name_Present then
 444                Osint.Fail ("duplicate -o switch");
 445             else
 446                Output_File_Name_Present := True;
 447             end if;
 448
 449          --  Processing for O switch
 450
 451          when 'O' =>
 452             Ptr := Ptr + 1;
 453             Output_Object_List := True;
 454             Object_List_Filename := Get_Optional_Filename;
 455
 456          --  Processing for p switch
 457
 458          when 'p' =>
 459             Ptr := Ptr + 1;
 460             Pessimistic_Elab_Order := True;
 461
 462          --  Processing for P switch
 463
 464          when 'P' =>
 465             Ptr := Ptr + 1;
 466             CodePeer_Mode := True;
 467
 468          --  Processing for q switch
 469
 470          when 'q' =>
 471             Ptr := Ptr + 1;
 472             Quiet_Output := True;
 473
 474          --  Processing for Q switch
 475
 476          when 'Q' =>
 477             if Ptr = Max then
 478                Bad_Switch (Switch_Chars);
 479             end if;
 480
 481             Ptr := Ptr + 1;
 482             Scan_Nat
 483               (Switch_Chars, Max, Ptr,
 484                Quantity_Of_Default_Size_Sec_Stacks, C);
 485
 486          --  Processing for r switch
 487
 488          when 'r' =>
 489             Ptr := Ptr + 1;
 490             List_Restrictions := True;
 491
 492          --  Processing for R switch
 493
 494          when 'R' =>
 495             Ptr := Ptr + 1;
 496             List_Closure := True;
 497
 498             if Ptr <= Max and then Switch_Chars (Ptr) = 'a' then
 499                Ptr := Ptr + 1;
 500                List_Closure_All := True;
 501             end if;
 502
 503          --  Processing for s switch
 504
 505          when 's' =>
 506             Ptr := Ptr + 1;
 507             All_Sources := True;
 508             Check_Source_Files := True;
 509
 510          --  Processing for t switch
 511
 512          when 't' =>
 513             Ptr := Ptr + 1;
 514             Tolerate_Consistency_Errors := True;
 515
 516          --  Processing for T switch
 517
 518          when 'T' =>
 519             if Ptr = Max then
 520                Bad_Switch (Switch_Chars);
 521             end if;
 522
 523             Ptr := Ptr + 1;
 524             Time_Slice_Set := True;
 525             Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value, C);
 526             Time_Slice_Value := Time_Slice_Value * 1_000;
 527
 528          --  Processing for u switch
 529
 530          when 'u' =>
 531             if Ptr = Max then
 532                Bad_Switch (Switch_Chars);
 533             end if;
 534
 535             Ptr := Ptr + 1;
 536             Dynamic_Stack_Measurement := True;
 537             Scan_Nat
 538               (Switch_Chars,
 539                Max,
 540                Ptr,
 541                Dynamic_Stack_Measurement_Array_Size,
 542                C);
 543
 544          --  Processing for v switch
 545
 546          when 'v' =>
 547             Ptr := Ptr + 1;
 548             Verbose_Mode := True;
 549
 550          --  Processing for V switch
 551
 552          when 'V' =>
 553             declare
 554                Eq : Integer;
 555             begin
 556                Ptr := Ptr + 1;
 557                Eq := Ptr;
 558                while Eq <= Max and then Switch_Chars (Eq) /= '=' loop
 559                   Eq := Eq + 1;
 560                end loop;
 561                if Eq = Ptr or else Eq = Max then
 562                   Bad_Switch (Switch_Chars);
 563                end if;
 564                Bindgen.Set_Bind_Env
 565                  (Key   => Switch_Chars (Ptr .. Eq - 1),
 566                   Value => Switch_Chars (Eq + 1 .. Max));
 567                Ptr := Max + 1;
 568             end;
 569
 570          --  Processing for w switch
 571
 572          when 'w' =>
 573             if Ptr = Max then
 574                Bad_Switch (Switch_Chars);
 575             end if;
 576
 577             --  For the binder we only allow suppress/error cases
 578
 579             Ptr := Ptr + 1;
 580
 581             case Switch_Chars (Ptr) is
 582                when 'e' =>
 583                   Warning_Mode := Treat_As_Error;
 584
 585                when 'E' =>
 586                   Warning_Mode := Treat_Run_Time_Warnings_As_Errors;
 587
 588                when 's' =>
 589                   Warning_Mode := Suppress;
 590
 591                when others =>
 592                   Bad_Switch (Switch_Chars);
 593             end case;
 594
 595             Ptr := Ptr + 1;
 596
 597          --  Processing for W switch
 598
 599          when 'W' =>
 600             Ptr := Ptr + 1;
 601
 602             if Ptr > Max then
 603                Bad_Switch (Switch_Chars);
 604             end if;
 605
 606             begin
 607                Wide_Character_Encoding_Method :=
 608                  Get_WC_Encoding_Method (Switch_Chars (Ptr));
 609             exception
 610                when Constraint_Error =>
 611                   Bad_Switch (Switch_Chars);
 612             end;
 613
 614             Wide_Character_Encoding_Method_Specified := True;
 615
 616             Upper_Half_Encoding :=
 617               Wide_Character_Encoding_Method in WC_Upper_Half_Encoding_Method;
 618
 619             Ptr := Ptr + 1;
 620
 621          --  Processing for x switch
 622
 623          when 'x' =>
 624             Ptr := Ptr + 1;
 625             All_Sources := False;
 626             Check_Source_Files := False;
 627
 628          --  Processing for X switch
 629
 630          when 'X' =>
 631             if Ptr = Max then
 632                Bad_Switch (Switch_Chars);
 633             end if;
 634
 635             Ptr := Ptr + 1;
 636             Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status, C);
 637
 638          --  Processing for y switch
 639
 640          when 'y' =>
 641             Ptr := Ptr + 1;
 642             Leap_Seconds_Support := True;
 643
 644          --  Processing for z switch
 645
 646          when 'z' =>
 647             Ptr := Ptr + 1;
 648             No_Main_Subprogram := True;
 649
 650          --  Processing for Z switch
 651
 652          when 'Z' =>
 653             Ptr := Ptr + 1;
 654             Zero_Formatting := True;
 655
 656          --  Processing for --RTS
 657
 658          when '-' =>
 659
 660             if Ptr + 4 <= Max and then
 661               Switch_Chars (Ptr + 1 .. Ptr + 3) = "RTS"
 662             then
 663                Ptr := Ptr + 4;
 664
 665                if Switch_Chars (Ptr) /= '=' or else Ptr = Max then
 666                   Osint.Fail ("missing path for --RTS");
 667
 668                else
 669                   --  Valid --RTS switch
 670
 671                   Opt.No_Stdinc := True;
 672                   Opt.RTS_Switch := True;
 673
 674                   declare
 675                      Src_Path_Name : constant String_Ptr :=
 676                                        Get_RTS_Search_Dir
 677                                          (Switch_Chars (Ptr + 1 .. Max),
 678                                           Include);
 679                      Lib_Path_Name : constant String_Ptr :=
 680                                        Get_RTS_Search_Dir
 681                                          (Switch_Chars (Ptr + 1 .. Max),
 682                                           Objects);
 683
 684                   begin
 685                      if Src_Path_Name /= null and then
 686                        Lib_Path_Name /= null
 687                      then
 688                         --  Set the RTS_*_Path_Name variables, so that the
 689                         --  correct directories will be set when a subsequent
 690                         --  call Osint.Add_Default_Search_Dirs is made.
 691
 692                         RTS_Src_Path_Name := Src_Path_Name;
 693                         RTS_Lib_Path_Name := Lib_Path_Name;
 694
 695                         Ptr := Max + 1;
 696
 697                      elsif Src_Path_Name = null
 698                        and then Lib_Path_Name = null
 699                      then
 700                         Osint.Fail
 701                           ("RTS path not valid: missing adainclude and "
 702                            & "adalib directories");
 703                      elsif Src_Path_Name = null then
 704                         Osint.Fail
 705                           ("RTS path not valid: missing adainclude directory");
 706                      elsif Lib_Path_Name = null then
 707                         Osint.Fail
 708                           ("RTS path not valid: missing adalib directory");
 709                      end if;
 710                   end;
 711                end if;
 712
 713             else
 714                Bad_Switch (Switch_Chars);
 715             end if;
 716
 717          --  Anything else is an error (illegal switch character)
 718
 719          when others =>
 720             Bad_Switch (Switch_Chars);
 721          end case;
 722
 723          if Ptr <= Max then
 724             Bad_Switch (Switch_Chars);
 725          end if;
 726       end Check_Switch;
 727    end Scan_Binder_Switches;
 728
 729 end Switch.B;