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