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