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