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