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-2005 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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, 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    begin
  45       --  Skip past the initial character (must be the switch character)
  46
  47       if Ptr = Max then
  48          raise Bad_Switch;
  49       else
  50          Ptr := Ptr + 1;
  51       end if;
  52
  53       --  A little check, "gnat" at the start of a switch is not allowed
  54       --  except for the compiler
  55
  56       if Switch_Chars'Last >= Ptr + 3
  57         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
  58       then
  59          Osint.Fail ("invalid switch: """, Switch_Chars, """"
  60             & " (gnat not needed here)");
  61       end if;
  62
  63       --  Loop to scan through switches given in switch string
  64
  65       while Ptr <= Max loop
  66          C := Switch_Chars (Ptr);
  67
  68          case C is
  69
  70          --  Processing for A switch
  71
  72          when 'A' =>
  73             Ptr := Ptr + 1;
  74
  75             Ada_Bind_File := True;
  76
  77          --  Processing for b switch
  78
  79          when 'b' =>
  80             Ptr := Ptr + 1;
  81             Brief_Output := True;
  82
  83          --  Processing for c switch
  84
  85          when 'c' =>
  86             Ptr := Ptr + 1;
  87
  88             Check_Only := True;
  89
  90          --  Processing for C switch
  91
  92          when 'C' =>
  93             Ptr := Ptr + 1;
  94
  95             Ada_Bind_File := False;
  96
  97          --  Processing for d switch
  98
  99          when 'd' =>
 100
 101             --  Note: for the debug switch, the remaining characters in this
 102             --  switch field must all be debug flags, since all valid switch
 103             --  characters are also valid debug characters. This switch is not
 104             --  documented on purpose because it is only used by the
 105             --  implementors.
 106
 107             --  Loop to scan out debug flags
 108
 109             while Ptr < Max loop
 110                Ptr := Ptr + 1;
 111                C := Switch_Chars (Ptr);
 112                exit when C = ASCII.NUL or else C = '/' or else C = '-';
 113
 114                if C in '1' .. '9' or else
 115                   C in 'a' .. 'z' or else
 116                   C in 'A' .. 'Z'
 117                then
 118                   Set_Debug_Flag (C);
 119                else
 120                   raise Bad_Switch;
 121                end if;
 122             end loop;
 123
 124             --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
 125             --  is for backwards compatibility with old versions and usage.
 126
 127             if Debug_Flag_XX then
 128                Zero_Cost_Exceptions_Set := True;
 129                Zero_Cost_Exceptions_Val := True;
 130             end if;
 131
 132             return;
 133
 134          --  Processing for D switch
 135
 136          when 'D' =>
 137             Ptr := Ptr + 1;
 138             Scan_Pos (Switch_Chars, Max, Ptr, Default_Sec_Stack_Size);
 139
 140          --  Processing for e switch
 141
 142          when 'e' =>
 143             Ptr := Ptr + 1;
 144             Elab_Dependency_Output := True;
 145
 146          --  Processing for E switch
 147
 148          when 'E' =>
 149             Ptr := Ptr + 1;
 150             Exception_Tracebacks := True;
 151
 152          --  Processing for f switch
 153
 154          when 'f' =>
 155             Ptr := Ptr + 1;
 156             Force_RM_Elaboration_Order := True;
 157
 158          --  Processing for F switch
 159
 160          when 'F' =>
 161             Ptr := Ptr + 1;
 162             Force_Checking_Of_Elaboration_Flags := True;
 163
 164          --  Processing for g switch
 165
 166          when 'g' =>
 167             Ptr := Ptr + 1;
 168
 169             if Ptr <= Max then
 170                C := Switch_Chars (Ptr);
 171
 172                if C in '0' .. '3' then
 173                   Debugger_Level :=
 174                     Character'Pos
 175                       (Switch_Chars (Ptr)) - Character'Pos ('0');
 176                   Ptr := Ptr + 1;
 177                end if;
 178
 179             else
 180                Debugger_Level := 2;
 181             end if;
 182
 183          --  Processing for h switch
 184
 185          when 'h' =>
 186             Ptr := Ptr + 1;
 187             Usage_Requested := True;
 188
 189          --  Processing for i switch
 190
 191          when 'i' =>
 192             if Ptr = Max then
 193                raise Bad_Switch;
 194             end if;
 195
 196             Ptr := Ptr + 1;
 197             C := Switch_Chars (Ptr);
 198
 199             if C in  '1' .. '5'
 200               or else C = '8'
 201               or else C = 'p'
 202               or else C = 'f'
 203               or else C = 'n'
 204               or else C = 'w'
 205             then
 206                Identifier_Character_Set := C;
 207                Ptr := Ptr + 1;
 208             else
 209                raise Bad_Switch;
 210             end if;
 211
 212          --  Processing for K switch
 213
 214          when 'K' =>
 215             Ptr := Ptr + 1;
 216             Output_Linker_Option_List := True;
 217
 218          --  Processing for l switch
 219
 220          when 'l' =>
 221             Ptr := Ptr + 1;
 222             Elab_Order_Output := True;
 223
 224          --  Processing for m switch
 225
 226          when 'm' =>
 227             Ptr := Ptr + 1;
 228             Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
 229
 230          --  Processing for n switch
 231
 232          when 'n' =>
 233             Ptr := Ptr + 1;
 234             Bind_Main_Program := False;
 235
 236             --  Note: The -L option of the binder also implies -n, so
 237             --  any change here must also be reflected in the processing
 238             --  for -L that is found in Gnatbind.Scan_Bind_Arg.
 239
 240          --  Processing for o switch
 241
 242          when 'o' =>
 243             Ptr := Ptr + 1;
 244
 245             if Output_File_Name_Present then
 246                raise Too_Many_Output_Files;
 247
 248             else
 249                Output_File_Name_Present := True;
 250             end if;
 251
 252          --  Processing for O switch
 253
 254          when 'O' =>
 255             Ptr := Ptr + 1;
 256             Output_Object_List := True;
 257
 258          --  Processing for p switch
 259
 260          when 'p' =>
 261             Ptr := Ptr + 1;
 262             Pessimistic_Elab_Order := True;
 263
 264          --  Processing for q switch
 265
 266          when 'q' =>
 267             Ptr := Ptr + 1;
 268             Quiet_Output := True;
 269
 270          --  Processing for r switch
 271
 272          when 'r' =>
 273             Ptr := Ptr + 1;
 274             List_Restrictions := True;
 275
 276          --  Processing for s switch
 277
 278          when 's' =>
 279             Ptr := Ptr + 1;
 280             All_Sources := True;
 281             Check_Source_Files := True;
 282
 283          --  Processing for t switch
 284
 285          when 't' =>
 286             Ptr := Ptr + 1;
 287             Tolerate_Consistency_Errors := True;
 288
 289          --  Processing for T switch
 290
 291          when 'T' =>
 292             Ptr := Ptr + 1;
 293             Time_Slice_Set := True;
 294             Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);
 295             Time_Slice_Value := Time_Slice_Value * 1_000;
 296
 297          --  Processing for v switch
 298
 299          when 'v' =>
 300             Ptr := Ptr + 1;
 301             Verbose_Mode := True;
 302
 303          --  Processing for w switch
 304
 305          when 'w' =>
 306
 307             --  For the binder we only allow suppress/error cases
 308
 309             Ptr := Ptr + 1;
 310
 311             case Switch_Chars (Ptr) is
 312
 313                when 'e' =>
 314                   Warning_Mode  := Treat_As_Error;
 315
 316                when 's' =>
 317                   Warning_Mode  := Suppress;
 318
 319                when others =>
 320                   raise Bad_Switch;
 321             end case;
 322
 323             Ptr := Ptr + 1;
 324
 325          --  Processing for W switch
 326
 327          when 'W' =>
 328             Ptr := Ptr + 1;
 329
 330             for J in WC_Encoding_Method loop
 331                if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
 332                   Wide_Character_Encoding_Method := J;
 333                   exit;
 334
 335                elsif J = WC_Encoding_Method'Last then
 336                   raise Bad_Switch;
 337                end if;
 338             end loop;
 339
 340             Upper_Half_Encoding :=
 341               Wide_Character_Encoding_Method in
 342                 WC_Upper_Half_Encoding_Method;
 343
 344             Ptr := Ptr + 1;
 345
 346          --  Processing for x switch
 347
 348          when 'x' =>
 349             Ptr := Ptr + 1;
 350             All_Sources := False;
 351             Check_Source_Files := False;
 352
 353          --  Processing for X switch
 354
 355          when 'X' =>
 356             Ptr := Ptr + 1;
 357             Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status);
 358
 359          --  Processing for z switch
 360
 361          when 'z' =>
 362             Ptr := Ptr + 1;
 363             No_Main_Subprogram := True;
 364
 365          --  Ignore extra switch character
 366
 367          when '/'  =>
 368             Ptr := Ptr + 1;
 369
 370          --  Ignore '-' extra switch caracter, only if it isn't followed by
 371          --  'RTS'. If it is, then we must process the 'RTS' switch
 372
 373          when '-' =>
 374
 375             if Ptr + 3 <= Max and then
 376               Switch_Chars (Ptr + 1 .. Ptr + 3) = "RTS"
 377             then
 378                Ptr := Ptr + 1;
 379
 380                if Switch_Chars (Ptr + 3) /= '=' or else
 381                  (Switch_Chars (Ptr + 3) = '='
 382                   and then Ptr + 4 > Max)
 383                then
 384                   Osint.Fail ("missing path for --RTS");
 385                else
 386
 387                   --  valid --RTS switch
 388                   Opt.No_Stdinc := True;
 389                   Opt.RTS_Switch := True;
 390
 391                   declare
 392                      Src_Path_Name : constant String_Ptr :=
 393                                        Get_RTS_Search_Dir
 394                                          (Switch_Chars
 395                                            (Ptr + 4 .. Switch_Chars'Last),
 396                                           Include);
 397                      Lib_Path_Name : constant String_Ptr :=
 398                                        Get_RTS_Search_Dir
 399                                          (Switch_Chars
 400                                            (Ptr + 4 .. Switch_Chars'Last),
 401                                           Objects);
 402
 403                   begin
 404                      if Src_Path_Name /= null and then
 405                        Lib_Path_Name /= null
 406                      then
 407                         --  Set the RTS_*_Path_Name variables, so that the
 408                         --  correct directories will be set when
 409                         --  Osint.Add_Default_Search_Dirs will be called later.
 410
 411                         RTS_Src_Path_Name := Src_Path_Name;
 412                         RTS_Lib_Path_Name := Lib_Path_Name;
 413
 414                         --  We can exit as there can not be another switch
 415                         --  after --RTS
 416
 417                         exit;
 418
 419                      elsif  Src_Path_Name = null
 420                        and then Lib_Path_Name = null
 421                      then
 422                         Osint.Fail ("RTS path not valid: missing " &
 423                                     "adainclude and adalib directories");
 424                      elsif Src_Path_Name = null then
 425                         Osint.Fail ("RTS path not valid: missing " &
 426                                     "adainclude directory");
 427                      elsif  Lib_Path_Name = null then
 428                         Osint.Fail ("RTS path not valid: missing " &
 429                                     "adalib directory");
 430                      end if;
 431                   end;
 432                end if;
 433
 434             else
 435                Ptr := Ptr + 1;
 436             end if;
 437
 438          --  Anything else is an error (illegal switch character)
 439
 440          when others =>
 441             raise Bad_Switch;
 442          end case;
 443       end loop;
 444
 445    exception
 446       when Bad_Switch =>
 447          Osint.Fail ("invalid switch: ", (1 => C));
 448
 449       when Bad_Switch_Value =>
 450          Osint.Fail ("numeric value out of range for switch: ", (1 => C));
 451
 452       when Missing_Switch_Value =>
 453          Osint.Fail ("missing numeric value for switch: ", (1 => C));
 454
 455       when Too_Many_Output_Files =>
 456          Osint.Fail ("duplicate -o switch");
 457    end Scan_Binder_Switches;
 458
 459 end Switch.B;