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