------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                               S W I T C H                                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision$
--                                                                          --
--          Copyright (C) 1992-2001, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

--  Option switch scanning for both the compiler and the binder

--  Note: this version of the package should be usable in both Unix and DOS

with Debug;    use Debug;
with Osint;    use Osint;
with Opt;      use Opt;
with Validsw;  use Validsw;
with Stylesw;  use Stylesw;
with Types;    use Types;

with System.WCh_Con; use System.WCh_Con;

package body Switch is

   Bad_Switch : exception;
   --  Exception raised if bad switch encountered

   Bad_Switch_Value : exception;
   --  Exception raised if bad switch value encountered

   Missing_Switch_Value : exception;
   --  Exception raised if no switch value encountered

   Too_Many_Output_Files : exception;
   --  Exception raised if the -o switch is encountered more than once

   Switch_Max_Value : constant := 999;
   --  Maximum value permitted in switches that take a value

   procedure Scan_Nat
     (Switch_Chars : String;
      Max          : Integer;
      Ptr          : in out Integer;
      Result       : out Nat);
   --  Scan natural integer parameter for switch. On entry, Ptr points
   --  just past the switch character, on exit it points past the last
   --  digit of the integer value.

   procedure Scan_Pos
     (Switch_Chars : String;
      Max          : Integer;
      Ptr          : in out Integer;
      Result       : out Pos);
   --  Scan positive integer parameter for switch. On entry, Ptr points
   --  just past the switch character, on exit it points past the last
   --  digit of the integer value.

   -------------------------
   -- Is_Front_End_Switch --
   -------------------------

   function Is_Front_End_Switch (Switch_Chars : String) return Boolean is
      Ptr       : constant Positive := Switch_Chars'First;
   begin
      return Is_Switch (Switch_Chars)
        and then
          (Switch_Chars (Ptr + 1) = 'I'
             or else
          (Switch_Chars'Length >= 5
                         and then Switch_Chars (Ptr + 1 .. Ptr + 4) = "gnat"));
   end Is_Front_End_Switch;

   ---------------
   -- Is_Switch --
   ---------------

   function Is_Switch (Switch_Chars : String) return Boolean is
   begin
      return Switch_Chars'Length > 1
        and then (Switch_Chars (Switch_Chars'First) = '-'
                     or
                  Switch_Chars (Switch_Chars'First) = Switch_Character);
   end Is_Switch;

   --------------------------
   -- Scan_Binder_Switches --
   --------------------------

   procedure Scan_Binder_Switches (Switch_Chars : String) is
      Ptr : Integer := Switch_Chars'First;
      Max : Integer := Switch_Chars'Last;
      C   : Character := ' ';

   begin
      --  Skip past the initial character (must be the switch character)

      if Ptr = Max then
         raise Bad_Switch;
      else
         Ptr := Ptr + 1;
      end if;

      --  A little check, "gnat" at the start of a switch is not allowed
      --  except for the compiler

      if Switch_Chars'Last >= Ptr + 3
        and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
      then
         Osint.Fail ("invalid switch: """, Switch_Chars, """"
            & " (gnat not needed here)");

      end if;

      --  Loop to scan through switches given in switch string

      while Ptr <= Max loop
         C := Switch_Chars (Ptr);

         case C is

         --  Processing for A switch

         when 'A' =>
            Ptr := Ptr + 1;

            Ada_Bind_File := True;

         --  Processing for b switch

         when 'b' =>
            Ptr := Ptr + 1;
            Brief_Output := True;

         --  Processing for c switch

         when 'c' =>
            Ptr := Ptr + 1;

            Check_Only := True;

         --  Processing for C switch

         when 'C' =>
            Ptr := Ptr + 1;

            Ada_Bind_File := False;

         --  Processing for d switch

         when 'd' =>

            --  Note: for the debug switch, the remaining characters in this
            --  switch field must all be debug flags, since all valid switch
            --  characters are also valid debug characters.

            --  Loop to scan out debug flags

            while Ptr < Max loop
               Ptr := Ptr + 1;
               C := Switch_Chars (Ptr);
               exit when C = ASCII.NUL or else C = '/' or else C = '-';

               if C in '1' .. '9' or else
                  C in 'a' .. 'z' or else
                  C in 'A' .. 'Z'
               then
                  Set_Debug_Flag (C);
               else
                  raise Bad_Switch;
               end if;
            end loop;

            --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
            --  is for backwards compatibility with old versions and usage.

            if Debug_Flag_XX then
               Zero_Cost_Exceptions_Set := True;
               Zero_Cost_Exceptions_Val := True;
            end if;

            return;

         --  Processing for e switch

         when 'e' =>
            Ptr := Ptr + 1;
            Elab_Dependency_Output := True;

         --  Processing for E switch

         when 'E' =>
            Ptr := Ptr + 1;
            Exception_Tracebacks := True;

         --  Processing for f switch

         when 'f' =>
            Ptr := Ptr + 1;
            Force_RM_Elaboration_Order := True;

         --  Processing for g switch

         when 'g' =>
            Ptr := Ptr + 1;

            if Ptr <= Max then
               C := Switch_Chars (Ptr);

               if C in '0' .. '3' then
                  Debugger_Level :=
                    Character'Pos
                      (Switch_Chars (Ptr)) - Character'Pos ('0');
                  Ptr := Ptr + 1;
               end if;

            else
               Debugger_Level := 2;
            end if;

         --  Processing for G switch

         when 'G' =>
            Ptr := Ptr + 1;
            Print_Generated_Code := True;

         --  Processing for h switch

         when 'h' =>
            Ptr := Ptr + 1;
            Usage_Requested := True;

         --  Processing for i switch

         when 'i' =>
            if Ptr = Max then
               raise Bad_Switch;
            end if;

            Ptr := Ptr + 1;
            C := Switch_Chars (Ptr);

            if C in  '1' .. '5'
              or else C = '8'
              or else C = 'p'
              or else C = 'f'
              or else C = 'n'
              or else C = 'w'
            then
               Identifier_Character_Set := C;
               Ptr := Ptr + 1;
            else
               raise Bad_Switch;
            end if;

         --  Processing for K switch

         when 'K' =>
            Ptr := Ptr + 1;

            if Program = Binder then
               Output_Linker_Option_List := True;
            else
               raise Bad_Switch;
            end if;

         --  Processing for l switch

         when 'l' =>
            Ptr := Ptr + 1;
            Elab_Order_Output := True;

         --  Processing for m switch

         when 'm' =>
            Ptr := Ptr + 1;
            Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);

         --  Processing for n switch

         when 'n' =>
            Ptr := Ptr + 1;
            Bind_Main_Program := False;

            --  Note: The -L option of the binder also implies -n, so
            --  any change here must also be reflected in the processing
            --  for -L that is found in Gnatbind.Scan_Bind_Arg.

         --  Processing for o switch

         when 'o' =>
            Ptr := Ptr + 1;

            if Output_File_Name_Present then
               raise Too_Many_Output_Files;

            else
               Output_File_Name_Present := True;
            end if;

         --  Processing for O switch

         when 'O' =>
            Ptr := Ptr + 1;
            Output_Object_List := True;

         --  Processing for p switch

         when 'p' =>
            Ptr := Ptr + 1;
            Pessimistic_Elab_Order := True;

         --  Processing for q switch

         when 'q' =>
            Ptr := Ptr + 1;
            Quiet_Output := True;

         --  Processing for s switch

         when 's' =>
            Ptr := Ptr + 1;
            All_Sources := True;
            Check_Source_Files := True;

         --  Processing for t switch

         when 't' =>
            Ptr := Ptr + 1;
            Tolerate_Consistency_Errors := True;

         --  Processing for T switch

         when 'T' =>
            Ptr := Ptr + 1;
            Time_Slice_Set := True;
            Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);

         --  Processing for v switch

         when 'v' =>
            Ptr := Ptr + 1;
            Verbose_Mode := True;

         --  Processing for w switch

         when 'w' =>

            --  For the binder we only allow suppress/error cases

            Ptr := Ptr + 1;

            case Switch_Chars (Ptr) is

               when 'e' =>
                  Warning_Mode  := Treat_As_Error;

               when 's' =>
                  Warning_Mode  := Suppress;

               when others =>
                  raise Bad_Switch;
            end case;

            Ptr := Ptr + 1;

         --  Processing for W switch

         when 'W' =>
            Ptr := Ptr + 1;

            for J in WC_Encoding_Method loop
               if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
                  Wide_Character_Encoding_Method := J;
                  exit;

               elsif J = WC_Encoding_Method'Last then
                  raise Bad_Switch;
               end if;
            end loop;

            Upper_Half_Encoding :=
              Wide_Character_Encoding_Method in
                WC_Upper_Half_Encoding_Method;

            Ptr := Ptr + 1;

         --  Processing for x switch

         when 'x' =>
            Ptr := Ptr + 1;
            All_Sources := False;
            Check_Source_Files := False;

         --  Processing for z switch

         when 'z' =>
            Ptr := Ptr + 1;
            No_Main_Subprogram := True;

         --  Ignore extra switch character

         when '/' | '-' =>
            Ptr := Ptr + 1;

         --  Anything else is an error (illegal switch character)

         when others =>
            raise Bad_Switch;
         end case;
      end loop;

   exception
      when Bad_Switch =>
         Osint.Fail ("invalid switch: ", (1 => C));

      when Bad_Switch_Value =>
         Osint.Fail ("numeric value too big for switch: ", (1 => C));

      when Missing_Switch_Value =>
         Osint.Fail ("missing numeric value for switch: ", (1 => C));

      when Too_Many_Output_Files =>
         Osint.Fail ("duplicate -o switch");
   end Scan_Binder_Switches;

   -----------------------------
   -- Scan_Front_End_Switches --
   -----------------------------

   procedure Scan_Front_End_Switches (Switch_Chars : String) is
      Switch_Starts_With_Gnat : Boolean;
      Ptr : Integer := Switch_Chars'First;
      Max : constant Integer := Switch_Chars'Last;
      C   : Character := ' ';

   begin
      --  Skip past the initial character (must be the switch character)

      if Ptr = Max then
         raise Bad_Switch;

      else
         Ptr := Ptr + 1;
      end if;

      --  A little check, "gnat" at the start of a switch is not allowed
      --  except for the compiler (where it was already removed)

      Switch_Starts_With_Gnat :=
         Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";

      if Switch_Starts_With_Gnat then
         Ptr := Ptr + 4;
      end if;

      --  Loop to scan through switches given in switch string

      while Ptr <= Max loop
         C := Switch_Chars (Ptr);

         --  Processing for a switch

         case Switch_Starts_With_Gnat is

         when False =>
            --  There is only one front-end switch that
            --  does not start with -gnat, namely -I

            case C is

            when 'I' =>
               Ptr := Ptr + 1;

               if Ptr > Max then
                  raise Bad_Switch;
               end if;

               --  Find out whether this is a -I- or regular -Ixxx switch

               if Ptr = Max and then Switch_Chars (Ptr) = '-' then
                  Look_In_Primary_Dir := False;

               else
                  Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
               end if;

               Ptr := Max + 1;

            when others =>
               --  Should not happen, as Scan_Switches is supposed
               --  to be called for front-end switches only.
               --  Still, it is safest to raise Bad_Switch error.

               raise Bad_Switch;
            end case;

         when True =>
            --  Process -gnat* options

            case C is

            when 'a' =>
               Ptr := Ptr + 1;
               Assertions_Enabled := True;

            --  Processing for A switch

            when 'A' =>
               Ptr := Ptr + 1;
               Config_File := False;

            --  Processing for b switch

            when 'b' =>
               Ptr := Ptr + 1;
               Brief_Output := True;

            --  Processing for c switch

            when 'c' =>
               Ptr := Ptr + 1;
               Operating_Mode := Check_Semantics;

            --  Processing for C switch

            when 'C' =>
               Ptr := Ptr + 1;
               Compress_Debug_Names := True;

            --  Processing for d switch

            when 'd' =>

               --  Note: for the debug switch, the remaining characters in this
               --  switch field must all be debug flags, since all valid switch
               --  characters are also valid debug characters.

               --  Loop to scan out debug flags

               while Ptr < Max loop
                  Ptr := Ptr + 1;
                  C := Switch_Chars (Ptr);
                  exit when C = ASCII.NUL or else C = '/' or else C = '-';

                  if C in '1' .. '9' or else
                     C in 'a' .. 'z' or else
                     C in 'A' .. 'Z'
                  then
                     Set_Debug_Flag (C);

                  else
                     raise Bad_Switch;
                  end if;
               end loop;

               --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
               --  is for backwards compatibility with old versions and usage.

               if Debug_Flag_XX then
                  Zero_Cost_Exceptions_Set := True;
                  Zero_Cost_Exceptions_Val := True;
               end if;

               return;

            --  Processing for D switch

            when 'D' =>
               Ptr := Ptr + 1;

               --  Note: -gnatD also sets -gnatx (to turn off cross-reference
               --  generation in the ali file) since otherwise this generation
               --  gets confused by the "wrong" Sloc values put in the tree.

               Debug_Generated_Code := True;
               Xref_Active := False;
               Set_Debug_Flag ('g');

            --  Processing for e switch

            when 'e' =>
               Ptr := Ptr + 1;

               if Ptr > Max then
                  raise Bad_Switch;
               end if;

               case Switch_Chars (Ptr) is

                  --  Configuration pragmas

                  when 'c' =>
                     Ptr := Ptr + 1;

                     if Ptr > Max then
                        raise Bad_Switch;
                     end if;

                     Config_File_Name :=
                        new String'(Switch_Chars (Ptr .. Max));

                     return;

                  --  Mapping file

                  when 'm' =>
                     Ptr := Ptr + 1;

                     if Ptr > Max then
                        raise Bad_Switch;
                     end if;

                     Mapping_File_Name :=
                       new String'(Switch_Chars (Ptr .. Max));
                     return;

                  when others =>
                     raise Bad_Switch;
               end case;

            --  Processing for E switch

            when 'E' =>
               Ptr := Ptr + 1;
               Dynamic_Elaboration_Checks := True;

            --  Processing for f switch

            when 'f' =>
               Ptr := Ptr + 1;
               All_Errors_Mode := True;

            --  Processing for F switch

            when 'F' =>
               Ptr := Ptr + 1;
               External_Name_Exp_Casing := Uppercase;
               External_Name_Imp_Casing := Uppercase;

            --  Processing for g switch

            when 'g' =>
               Ptr := Ptr + 1;
               GNAT_Mode                := True;
               Identifier_Character_Set := 'n';
               Warning_Mode             := Treat_As_Error;
               Check_Unreferenced       := True;
               Check_Withs              := True;

               Set_Default_Style_Check_Options;

            --  Processing for G switch

            when 'G' =>
               Ptr := Ptr + 1;
               Print_Generated_Code := True;

            --  Processing for h switch

            when 'h' =>
               Ptr := Ptr + 1;
               Usage_Requested := True;

            --  Processing for H switch

            when 'H' =>
               Ptr := Ptr + 1;
               HLO_Active := True;

            --  Processing for i switch

            when 'i' =>
               if Ptr = Max then
                  raise Bad_Switch;
               end if;

               Ptr := Ptr + 1;
               C := Switch_Chars (Ptr);

               if C in '1' .. '5'
                 or else C = '8'
                 or else C = 'p'
                 or else C = 'f'
                 or else C = 'n'
                 or else C = 'w'
               then
                  Identifier_Character_Set := C;
                  Ptr := Ptr + 1;

               else
                  raise Bad_Switch;
               end if;

            --  Processing for k switch

            when 'k' =>
               Ptr := Ptr + 1;
               Scan_Pos (Switch_Chars, Max, Ptr, Maximum_File_Name_Length);

            --  Processing for l switch

            when 'l' =>
               Ptr := Ptr + 1;
               Full_List := True;

            --  Processing for L switch

            when 'L' =>
               Ptr := Ptr + 1;
               Zero_Cost_Exceptions_Set := True;
               Zero_Cost_Exceptions_Val := False;

            --  Processing for m switch

            when 'm' =>
               Ptr := Ptr + 1;
               Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);

            --  Processing for n switch

            when 'n' =>
               Ptr := Ptr + 1;
               Inline_Active := True;

            --  Processing for N switch

            when 'N' =>
               Ptr := Ptr + 1;
               Inline_Active := True;
               Front_End_Inlining := True;

            --  Processing for o switch

            when 'o' =>
               Ptr := Ptr + 1;
               Suppress_Options.Overflow_Checks := False;

            --  Processing for O switch

            when 'O' =>
               Ptr := Ptr + 1;
               Output_File_Name_Present := True;

            --  Processing for p switch

            when 'p' =>
               Ptr := Ptr + 1;
               Suppress_Options.Access_Checks        := True;
               Suppress_Options.Accessibility_Checks := True;
               Suppress_Options.Discriminant_Checks  := True;
               Suppress_Options.Division_Checks      := True;
               Suppress_Options.Elaboration_Checks   := True;
               Suppress_Options.Index_Checks         := True;
               Suppress_Options.Length_Checks        := True;
               Suppress_Options.Overflow_Checks      := True;
               Suppress_Options.Range_Checks         := True;
               Suppress_Options.Division_Checks      := True;
               Suppress_Options.Length_Checks        := True;
               Suppress_Options.Range_Checks         := True;
               Suppress_Options.Storage_Checks       := True;
               Suppress_Options.Tag_Checks           := True;

               Validity_Checks_On := False;

            --  Processing for P switch

            when 'P' =>
               Ptr := Ptr + 1;
               Polling_Required := True;

            --  Processing for q switch

            when 'q' =>
               Ptr := Ptr + 1;
               Try_Semantics := True;

            --  Processing for q switch

            when 'Q' =>
               Ptr := Ptr + 1;
               Force_ALI_Tree_File := True;
               Try_Semantics := True;

            --  Processing for r switch

            when 'r' =>
               Ptr := Ptr + 1;

               --  Temporarily allow -gnatr to mean -gnatyl (use RM layout)
               --  for compatibility with pre 3.12 versions of GNAT,
               --  to be removed for 3.13 ???

               Set_Style_Check_Options ("l");

            --  Processing for R switch

            when 'R' =>
               Ptr := Ptr + 1;
               Back_Annotate_Rep_Info := True;

               if Ptr <= Max
                 and then Switch_Chars (Ptr) in '0' .. '9'
               then
                  C := Switch_Chars (Ptr);

                  if C in '4' .. '9' then
                     raise Bad_Switch;
                  else
                     List_Representation_Info :=
                       Character'Pos (C) - Character'Pos ('0');
                     Ptr := Ptr + 1;
                  end if;

               else
                  List_Representation_Info := 1;
               end if;

            --  Processing for s switch

            when 's' =>
               Ptr := Ptr + 1;
               Operating_Mode := Check_Syntax;

            --  Processing for t switch

            when 't' =>
               Ptr := Ptr + 1;
               Tree_Output := True;
               Back_Annotate_Rep_Info := True;

            --  Processing for T switch

            when 'T' =>
               Ptr := Ptr + 1;
               Time_Slice_Set := True;
               Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);

            --  Processing for u switch

            when 'u' =>
               Ptr := Ptr + 1;
               List_Units := True;

            --  Processing for U switch

            when 'U' =>
               Ptr := Ptr + 1;
               Unique_Error_Tag := True;

            --  Processing for v switch

            when 'v' =>
               Ptr := Ptr + 1;
               Verbose_Mode := True;

            --  Processing for V switch

            when 'V' =>
               Ptr := Ptr + 1;

               if Ptr > Max then
                  raise Bad_Switch;

               else
                  declare
                     OK  : Boolean;

                  begin
                     Set_Validity_Check_Options
                       (Switch_Chars (Ptr .. Max), OK, Ptr);

                     if not OK then
                        raise Bad_Switch;
                     end if;
                  end;
               end if;

            --  Processing for w switch

            when 'w' =>
               Ptr := Ptr + 1;

               if Ptr > Max then
                  raise Bad_Switch;
               end if;

               while Ptr <= Max loop
                  C := Switch_Chars (Ptr);

                  case C is

                     when 'a' =>
                        Constant_Condition_Warnings  := True;
                        Elab_Warnings                := True;
                        Check_Unreferenced           := True;
                        Check_Withs                  := True;
                        Implementation_Unit_Warnings := True;
                        Ineffective_Inline_Warnings  := True;
                        Warn_On_Redundant_Constructs := True;

                     when 'A' =>
                        Constant_Condition_Warnings  := False;
                        Elab_Warnings                := False;
                        Check_Unreferenced           := False;
                        Check_Withs                  := False;
                        Implementation_Unit_Warnings := False;
                        Warn_On_Biased_Rounding      := False;
                        Warn_On_Hiding               := False;
                        Warn_On_Redundant_Constructs := False;
                        Ineffective_Inline_Warnings  := False;

                     when 'c' =>
                        Constant_Condition_Warnings := True;

                     when 'C' =>
                        Constant_Condition_Warnings := False;

                     when 'b' =>
                        Warn_On_Biased_Rounding := True;

                     when 'B' =>
                        Warn_On_Biased_Rounding := False;

                     when 'e' =>
                        Warning_Mode := Treat_As_Error;

                     when 'h' =>
                        Warn_On_Hiding := True;

                     when 'H' =>
                        Warn_On_Hiding := False;

                     when 'i' =>
                        Implementation_Unit_Warnings := True;

                     when 'I' =>
                        Implementation_Unit_Warnings := False;

                     when 'l' =>
                        Elab_Warnings := True;

                     when 'L' =>
                        Elab_Warnings := False;

                     when 'o' =>
                        Address_Clause_Overlay_Warnings := True;

                     when 'O' =>
                        Address_Clause_Overlay_Warnings := False;

                     when 'p' =>
                        Ineffective_Inline_Warnings := True;

                     when 'P' =>
                        Ineffective_Inline_Warnings := False;

                     when 'r' =>
                        Warn_On_Redundant_Constructs := True;

                     when 'R' =>
                        Warn_On_Redundant_Constructs := False;

                     when 's' =>
                        Warning_Mode  := Suppress;

                     when 'u' =>
                        Check_Unreferenced := True;
                        Check_Withs        := True;

                     when 'U' =>
                        Check_Unreferenced := False;
                        Check_Withs        := False;

                        --  Allow and ignore 'w' so that the old
                        --  format (e.g. -gnatwuwl) will work.

                     when 'w' =>
                        null;

                     when others =>
                        raise Bad_Switch;
                  end case;

                  Ptr := Ptr + 1;
               end loop;

               return;

            --  Processing for W switch

            when 'W' =>
               Ptr := Ptr + 1;

               for J in WC_Encoding_Method loop
                  if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
                     Wide_Character_Encoding_Method := J;
                     exit;

                  elsif J = WC_Encoding_Method'Last then
                     raise Bad_Switch;
                  end if;
               end loop;

               Upper_Half_Encoding :=
                 Wide_Character_Encoding_Method in
                 WC_Upper_Half_Encoding_Method;

               Ptr := Ptr + 1;

            --  Processing for x switch

            when 'x' =>
               Ptr := Ptr + 1;
               Xref_Active := False;

            --  Processing for X switch

            when 'X' =>
               Ptr := Ptr + 1;
               Extensions_Allowed := True;

            --  Processing for y switch

            when 'y' =>
               Ptr := Ptr + 1;

               if Ptr > Max then
                  Set_Default_Style_Check_Options;

               else
                  declare
                     OK  : Boolean;

                  begin
                     Set_Style_Check_Options
                       (Switch_Chars (Ptr .. Max), OK, Ptr);

                     if not OK then
                        raise Bad_Switch;
                     end if;
                  end;
               end if;

            --  Processing for z switch

            when 'z' =>
               Ptr := Ptr + 1;

               --  Allowed for compiler, only if this is the only
               --  -z switch, we do not allow multiple occurrences

               if Distribution_Stub_Mode = No_Stubs then
                  case Switch_Chars (Ptr) is
                     when 'r' =>
                        Distribution_Stub_Mode := Generate_Receiver_Stub_Body;

                     when 'c' =>
                        Distribution_Stub_Mode := Generate_Caller_Stub_Body;

                     when others =>
                        raise Bad_Switch;
                  end case;

                  Ptr := Ptr + 1;

               end if;

            --  Processing for Z switch

            when 'Z' =>
               Ptr := Ptr + 1;
               Zero_Cost_Exceptions_Set := True;
               Zero_Cost_Exceptions_Val := True;

            --  Processing for 83 switch

            when '8' =>

               if Ptr = Max then
                  raise Bad_Switch;
               end if;

               Ptr := Ptr + 1;

               if Switch_Chars (Ptr) /= '3' then
                  raise Bad_Switch;
               else
                  Ptr := Ptr + 1;
                  Ada_95 := False;
                  Ada_83 := True;
               end if;

            --  Ignore extra switch character

            when '/' | '-' =>
               Ptr := Ptr + 1;

            --  Anything else is an error (illegal switch character)

            when others =>
               raise Bad_Switch;
            end case;
         end case;
      end loop;

   exception
      when Bad_Switch =>
         Osint.Fail ("invalid switch: ", (1 => C));

      when Bad_Switch_Value =>
         Osint.Fail ("numeric value too big for switch: ", (1 => C));

      when Missing_Switch_Value =>
         Osint.Fail ("missing numeric value for switch: ", (1 => C));

   end Scan_Front_End_Switches;

   ------------------------
   -- Scan_Make_Switches --
   ------------------------

   procedure Scan_Make_Switches (Switch_Chars : String) is
      Ptr : Integer := Switch_Chars'First;
      Max : Integer := Switch_Chars'Last;
      C   : Character := ' ';

   begin
      --  Skip past the initial character (must be the switch character)

      if Ptr = Max then
         raise Bad_Switch;

      else
         Ptr := Ptr + 1;
      end if;

      --  A little check, "gnat" at the start of a switch is not allowed
      --  except for the compiler (where it was already removed)

      if Switch_Chars'Length >= Ptr + 3
        and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
      then
         Osint.Fail
           ("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
      end if;

      --  Loop to scan through switches given in switch string

      while Ptr <= Max loop
         C := Switch_Chars (Ptr);

         --  Processing for a switch

         case C is

         when 'a' =>
            Ptr := Ptr + 1;
            Check_Readonly_Files := True;

         --  Processing for b switch

         when 'b' =>
            Ptr := Ptr + 1;
            Bind_Only := True;

         --  Processing for c switch

         when 'c' =>
            Ptr := Ptr + 1;
            Compile_Only := True;

         when 'd' =>

            --  Note: for the debug switch, the remaining characters in this
            --  switch field must all be debug flags, since all valid switch
            --  characters are also valid debug characters.

            --  Loop to scan out debug flags

            while Ptr < Max loop
               Ptr := Ptr + 1;
               C := Switch_Chars (Ptr);
               exit when C = ASCII.NUL or else C = '/' or else C = '-';

               if C in '1' .. '9' or else
                  C in 'a' .. 'z' or else
                  C in 'A' .. 'Z'
               then
                  Set_Debug_Flag (C);
               else
                  raise Bad_Switch;
               end if;
            end loop;

            --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
            --  is for backwards compatibility with old versions and usage.

            if Debug_Flag_XX then
               Zero_Cost_Exceptions_Set := True;
               Zero_Cost_Exceptions_Val := True;
            end if;

            return;

         --  Processing for f switch

         when 'f' =>
            Ptr := Ptr + 1;
            Force_Compilations := True;

         --  Processing for G switch

         when 'G' =>
            Ptr := Ptr + 1;
            Print_Generated_Code := True;

         --  Processing for h switch

         when 'h' =>
            Ptr := Ptr + 1;
            Usage_Requested := True;

         --  Processing for i switch

         when 'i' =>
            Ptr := Ptr + 1;
            In_Place_Mode := True;

         --  Processing for j switch

         when 'j' =>
            Ptr := Ptr + 1;

            declare
               Max_Proc : Pos;
            begin
               Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc);
               Maximum_Processes := Positive (Max_Proc);
            end;

         --  Processing for k switch

         when 'k' =>
            Ptr := Ptr + 1;
            Keep_Going := True;

         --  Processing for l switch

         when 'l' =>
            Ptr := Ptr + 1;
            Link_Only := True;

         when 'M' =>
            Ptr := Ptr + 1;
            List_Dependencies := True;

         --  Processing for n switch

         when 'n' =>
            Ptr := Ptr + 1;
            Do_Not_Execute := True;

         --  Processing for o switch

         when 'o' =>
            Ptr := Ptr + 1;

            if Output_File_Name_Present then
               raise Too_Many_Output_Files;
            else
               Output_File_Name_Present := True;
            end if;

         --  Processing for q switch

         when 'q' =>
            Ptr := Ptr + 1;
            Quiet_Output := True;

         --  Processing for s switch

         when 's' =>
            Ptr := Ptr + 1;
            Check_Switches := True;

         --  Processing for v switch

         when 'v' =>
            Ptr := Ptr + 1;
            Verbose_Mode := True;

         --  Processing for z switch

         when 'z' =>
            Ptr := Ptr + 1;
            No_Main_Subprogram := True;

         --  Ignore extra switch character

         when '/' | '-' =>
            Ptr := Ptr + 1;

         --  Anything else is an error (illegal switch character)

         when others =>
            raise Bad_Switch;

         end case;
      end loop;

   exception
      when Bad_Switch =>
         Osint.Fail ("invalid switch: ", (1 => C));

      when Bad_Switch_Value =>
         Osint.Fail ("numeric value too big for switch: ", (1 => C));

      when Missing_Switch_Value =>
         Osint.Fail ("missing numeric value for switch: ", (1 => C));

      when Too_Many_Output_Files =>
         Osint.Fail ("duplicate -o switch");

   end Scan_Make_Switches;

   --------------
   -- Scan_Nat --
   --------------

   procedure Scan_Nat
     (Switch_Chars : String;
      Max          : Integer;
      Ptr          : in out Integer;
      Result       : out Nat) is
   begin
      Result := 0;
      if Ptr > Max or else Switch_Chars (Ptr) not in '0' .. '9' then
         raise Missing_Switch_Value;
      end if;

      while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop
         Result := Result * 10 +
           Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0');
         Ptr := Ptr + 1;

         if Result > Switch_Max_Value then
            raise Bad_Switch_Value;
         end if;
      end loop;
   end Scan_Nat;

   --------------
   -- Scan_Pos --
   --------------

   procedure Scan_Pos
     (Switch_Chars : String;
      Max          : Integer;
      Ptr          : in out Integer;
      Result       : out Pos) is

   begin
      Scan_Nat (Switch_Chars, Max, Ptr, Result);
      if Result = 0 then
         raise Bad_Switch_Value;
      end if;
   end Scan_Pos;

end Switch;