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