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