switch-c.adb   [plain text]

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             S W I T C H - C                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                                                                          --
--          Copyright (C) 2001-2002 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. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

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

with System.WCh_Con; use System.WCh_Con;

package body Switch.C is

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

   procedure Scan_Front_End_Switches (Switch_Chars : String) is
      Switch_Starts_With_Gnat : Boolean;
      --  True if first four switch characters are "gnat"

      First_Switch : Boolean := True;
      --  False for all but first switch

      Ptr : Integer := Switch_Chars'First;
      Max : constant Integer := Switch_Chars'Last;
      C   : Character := ' ';

      Store_Switch : Boolean  := True;
      First_Char   : Integer  := Ptr;
      Storing      : String   := Switch_Chars;
      First_Stored : Positive := Ptr + 1;
      --  The above need comments ???

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

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

      --  Remove "gnat" from the switch, if present

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

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

      --  Loop to scan through switches given in switch string

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

         --  Processing for a switch

         case Switch_Starts_With_Gnat is

            when False =>
            --  There are only two front-end switches that
            --  do not start with -gnat, namely -I and --RTS

               if Switch_Chars (Ptr) = 'I' then
                  Store_Switch := False;

                  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;

               --  Processing of the --RTS switch. --RTS has been modified by
               --  gcc and is now of the form -fRTS
               elsif Ptr + 3 <= Max and then
                 Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
               then
                  Ptr := Ptr + 1;

                  if Ptr + 4 > Max or else Switch_Chars (Ptr + 3) /= '=' then
                     Osint.Fail ("missing path for --RTS");
                  else

                     --  valid --RTS switch
                     Opt.No_Stdinc := True;
                     Opt.RTS_Switch := True;

                     declare
                        Src_Path_Name : String_Ptr := Get_RTS_Search_Dir
                          (Switch_Chars (Ptr + 4 .. Max), Include);
                        Lib_Path_Name : String_Ptr := Get_RTS_Search_Dir
                          (Switch_Chars (Ptr + 4 .. Max), Objects);
                     begin
                        if Src_Path_Name /= null and then
                          Lib_Path_Name /= null
                        then
                           Add_Search_Dirs (Src_Path_Name, Include);
                           Add_Search_Dirs (Lib_Path_Name, Objects);
                           Ptr := Max + 1;
                        elsif  Src_Path_Name = null
                          and Lib_Path_Name = null then
                           Osint.Fail ("RTS path not valid: missing " &
                                       "adainclude and adalib directories");
                        elsif Src_Path_Name = null then
                           Osint.Fail ("RTS path not valid: missing " &
                                       "adainclude directory");
                        elsif  Lib_Path_Name = null then
                           Osint.Fail ("RTS path not valid: missing " &
                                       "adalib directory");
                        end if;
                     end;
                  end if;
               else
                  raise Bad_Switch;
               end if;

         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' =>
               if not First_Switch then
                  Osint.Fail
                    ("-gnatc myust be first if combined with other switches");
               end if;

               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' =>
               Store_Switch := False;
               Storing (First_Stored) := '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);
                     Storing (First_Stored + 1) := C;
                     Store_Compilation_Switch
                       (Storing (Storing'First .. First_Stored + 1));

                  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' =>
                     Store_Switch := False;
                     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' =>
                     Store_Switch := False;
                     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 = '9'
                 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;
               Opt.Enable_Overflow_Checks := True;

            --  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.Storage_Checks       := True;
               Suppress_Options.Tag_Checks           := True;

               Validity_Checks_On := False;
               Opt.Suppress_Checks := True;
               Opt.Enable_Overflow_Checks := 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;
               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;

                  if Ptr <= Max and then Switch_Chars (Ptr) = 's' then
                     Ptr := Ptr + 1;

                     if List_Representation_Info /= 0 then
                        List_Representation_Info_To_File := True;
                     end if;
                  end if;

               else
                  List_Representation_Info := 1;
               end if;

            --  Processing for s switch

            when 's' =>
               if not First_Switch then
                  Osint.Fail
                    ("-gnats myust be first if combined with other switches");
               end if;

               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;
               Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor);

            --  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' =>
               Store_Switch := False;
               Storing (First_Stored) := '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;

                     for Index in First_Char + 1 .. Max loop
                        Storing (First_Stored + 1) :=
                          Switch_Chars (Index);
                        Store_Compilation_Switch
                          (Storing (Storing'First .. First_Stored + 1));
                     end loop;
                  end;
               end if;

               Ptr := Max + 1;

            --  Processing for w switch

            when 'w' =>
               Store_Switch := False;
               Storing (First_Stored) := '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;
                        Check_Unreferenced_Formals      := 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;
                        Check_Unreferenced_Formals      := False;
                        Implementation_Unit_Warnings    := False;
                        Warn_On_Biased_Rounding         := False;
                        Warn_On_Dereference             := False;
                        Warn_On_Hiding                  := False;
                        Warn_On_Redundant_Constructs    := False;
                        Ineffective_Inline_Warnings     := False;

                     when 'b' =>
                        Warn_On_Biased_Rounding         := True;

                     when 'B' =>
                        Warn_On_Biased_Rounding         := False;

                     when 'c' =>
                        Constant_Condition_Warnings     := True;

                     when 'C' =>
                        Constant_Condition_Warnings     := False;

                     when 'd' =>
                        Warn_On_Dereference             := True;

                     when 'D' =>
                        Warn_On_Dereference             := False;

                     when 'e' =>
                        Warning_Mode                    := Treat_As_Error;

                     when 'f' =>
                        Check_Unreferenced_Formals      := True;

                     when 'F' =>
                        Check_Unreferenced_Formals      := False;

                     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;
                        Check_Unreferenced_Formals      := True;

                     when 'U' =>
                        Check_Unreferenced              := False;
                        Check_Withs                     := False;
                        Check_Unreferenced_Formals      := 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;

                  if C /= 'w' then
                     Storing (First_Stored + 1) := C;
                     Store_Compilation_Switch
                       (Storing (Storing'First .. First_Stored + 1));
                  end if;

                  Ptr := Ptr + 1;
               end loop;

               return;

            --  Processing for W switch

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

               if Ptr > Max then
                  raise Bad_Switch;
               end if;

               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
                  Store_Switch := False;
                  Storing (First_Stored) := 'y';

                  declare
                     OK  : Boolean;
                     Last_Stored : Integer;

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

                     if not OK then
                        raise Bad_Switch;
                     end if;

                     Ptr := First_Char + 1;

                     while Ptr <= Max loop
                        Last_Stored := First_Stored + 1;
                        Storing (Last_Stored) := Switch_Chars (Ptr);

                        if Switch_Chars (Ptr) = 'M' then
                           loop
                              Ptr := Ptr + 1;
                              exit when Ptr > Max
                                or else Switch_Chars (Ptr) not in '0' .. '9';
                              Last_Stored := Last_Stored + 1;
                              Storing (Last_Stored) := Switch_Chars (Ptr);
                           end loop;

                        else
                           Ptr := Ptr + 1;
                        end if;

                        Store_Compilation_Switch
                          (Storing (Storing'First .. Last_Stored));
                     end loop;
                  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;

         if Store_Switch then
            Storing (First_Stored .. First_Stored + Ptr - First_Char - 1) :=
              Switch_Chars (First_Char .. Ptr - 1);
            Store_Compilation_Switch
              (Storing (Storing'First .. First_Stored + Ptr - First_Char - 1));
         end if;

         First_Switch := False;
      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;

end Switch.C;