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