diff gcc/ada/switch-b.adb @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/switch-b.adb	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,649 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S W I T C H - B                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2001-2017, 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 3,  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 COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Bindgen;
+with Debug;  use Debug;
+with Osint;  use Osint;
+with Opt;    use Opt;
+
+with System.OS_Lib;  use System.OS_Lib;
+with System.WCh_Con; use System.WCh_Con;
+
+package body Switch.B is
+
+   --------------------------
+   -- Scan_Binder_Switches --
+   --------------------------
+
+   procedure Scan_Binder_Switches (Switch_Chars : String) is
+      Max : constant Integer := Switch_Chars'Last;
+      Ptr : Integer          := Switch_Chars'First;
+      C   : Character        := ' ';
+
+      function Get_Optional_Filename return String_Ptr;
+      --  If current character is '=', return a newly allocated string that
+      --  contains the remainder of the current switch (after the '='), else
+      --  return null.
+
+      function Get_Stack_Size (S : Character) return Int;
+      --  Used for -d and -D to scan stack size including handling k/m. S is
+      --  set to 'd' or 'D' to indicate the switch being scanned.
+
+      ---------------------------
+      -- Get_Optional_Filename --
+      ---------------------------
+
+      function Get_Optional_Filename return String_Ptr is
+         Result : String_Ptr;
+
+      begin
+         if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            else
+               Result := new String'(Switch_Chars (Ptr + 1 .. Max));
+               Ptr := Max + 1;
+               return Result;
+            end if;
+         end if;
+
+         return null;
+      end Get_Optional_Filename;
+
+      --------------------
+      -- Get_Stack_Size --
+      --------------------
+
+      function Get_Stack_Size (S : Character) return Int is
+         Result : Int;
+
+      begin
+         Scan_Pos (Switch_Chars, Max, Ptr, Result, S);
+
+         --  In the following code, we enable overflow checking since the
+         --  multiplication by K or M may cause overflow, which is an error.
+
+         declare
+            pragma Unsuppress (Overflow_Check);
+
+         begin
+            --  Check for additional character 'k' (for kilobytes) or 'm' (for
+            --  Megabytes), but only if we have not reached the end of the
+            --  switch string. Note that if this appears before the end of the
+            --  string we will get an error when we test to make sure that the
+            --  string is exhausted (at the end of the case).
+
+            if Ptr <= Max then
+               if Switch_Chars (Ptr) = 'k' then
+                  Result := Result * 1024;
+                  Ptr := Ptr + 1;
+
+               elsif Switch_Chars (Ptr) = 'm' then
+                  Result := Result * (1024 * 1024);
+                  Ptr := Ptr + 1;
+               end if;
+            end if;
+
+         exception
+            when Constraint_Error =>
+               Osint.Fail ("numeric value out of range for switch: " & S);
+         end;
+
+         return Result;
+      end Get_Stack_Size;
+
+   --  Start of processing for Scan_Binder_Switches
+
+   begin
+      --  Skip past the initial character (must be the switch character)
+
+      if Ptr = Max then
+         Bad_Switch (Switch_Chars);
+      else
+         Ptr := Ptr + 1;
+      end if;
+
+      --  A little check, "gnat" at the start of a switch is not allowed except
+      --  for the compiler
+
+      if Max >= 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
+
+      Check_Switch : begin
+         C := Switch_Chars (Ptr);
+
+         case C is
+
+         --  Processing for a switch
+
+         when 'a' =>
+            Ptr := Ptr + 1;
+            Use_Pragma_Linker_Constructor := True;
+
+         --  Processing for A switch
+
+         when 'A' =>
+            Ptr := Ptr + 1;
+            Output_ALI_List := True;
+            ALI_List_Filename := Get_Optional_Filename;
+
+         --  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 d switch
+
+         when 'd' =>
+
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            Ptr := Ptr + 1;
+            C := Switch_Chars (Ptr);
+
+            --  Case where character after -d is a digit (default stack size)
+
+            if C in '0' .. '9' then
+
+               --  In this case, we process the default primary stack size
+
+               Default_Stack_Size := Get_Stack_Size ('d');
+
+            --  Case where character after -d is not digit (debug flags)
+
+            else
+               --  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. This switch is
+               --  not documented on purpose because it is only used by the
+               --  implementors.
+
+               --  Loop to scan out debug flags
+
+               loop
+                  C := Switch_Chars (Ptr);
+
+                  if C in 'a' .. 'z' or else C in 'A' .. 'Z' then
+                     Set_Debug_Flag (C);
+                  else
+                     Bad_Switch (Switch_Chars);
+                  end if;
+
+                  Ptr := Ptr + 1;
+                  exit when Ptr > Max;
+               end loop;
+            end if;
+
+         --  Processing for D switch
+
+         when 'D' =>
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            Ptr := Ptr + 1;
+            Default_Sec_Stack_Size := Get_Stack_Size ('D');
+
+         --  Processing for e switch
+
+         when 'e' =>
+            Ptr := Ptr + 1;
+            Elab_Dependency_Output := True;
+
+         --  Processing for E switch
+
+         when 'E' =>
+
+            --  -E is equivalent to -Ea (see below)
+
+            Exception_Tracebacks := True;
+            Ptr := Ptr + 1;
+
+            if Ptr <= Max then
+               case Switch_Chars (Ptr) is
+
+                  --  -Ea sets Exception_Tracebacks
+
+                  when 'a' => null;
+
+                  --  -Es sets both Exception_Tracebacks and
+                  --  Exception_Tracebacks_Symbolic.
+
+                  when 's' => Exception_Tracebacks_Symbolic := True;
+                  when others => Bad_Switch (Switch_Chars);
+               end case;
+
+               Ptr := Ptr + 1;
+            end if;
+
+         --  Processing for f switch
+
+         when 'f' =>
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            Force_Elab_Order_File :=
+              new String'(Switch_Chars (Ptr + 1 .. Max));
+
+            Ptr := Max + 1;
+
+            if not Is_Read_Accessible_File (Force_Elab_Order_File.all) then
+               Osint.Fail (Force_Elab_Order_File.all & ": file not found");
+            end if;
+
+         --  Processing for F switch
+
+         when 'F' =>
+            Ptr := Ptr + 1;
+            Force_Checking_Of_Elaboration_Flags := 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 h switch
+
+         when 'h' =>
+            Ptr := Ptr + 1;
+            Usage_Requested := True;
+
+         --  Processing for i switch
+
+         when 'i' =>
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            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
+               Bad_Switch (Switch_Chars);
+            end if;
+
+         --  Processing for K switch
+
+         when 'K' =>
+            Ptr := Ptr + 1;
+            Output_Linker_Option_List := True;
+
+         --  Processing for l switch
+
+         when 'l' =>
+            Ptr := Ptr + 1;
+            Elab_Order_Output := True;
+
+         --  Processing for m switch
+
+         when 'm' =>
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            Ptr := Ptr + 1;
+            Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Messages, C);
+
+         --  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
+               Osint.Fail ("duplicate -o switch");
+            else
+               Output_File_Name_Present := True;
+            end if;
+
+         --  Processing for O switch
+
+         when 'O' =>
+            Ptr := Ptr + 1;
+            Output_Object_List := True;
+            Object_List_Filename := Get_Optional_Filename;
+
+         --  Processing for p switch
+
+         when 'p' =>
+            Ptr := Ptr + 1;
+            Pessimistic_Elab_Order := True;
+
+         --  Processing for P switch
+
+         when 'P' =>
+            Ptr := Ptr + 1;
+            CodePeer_Mode := True;
+
+         --  Processing for q switch
+
+         when 'q' =>
+            Ptr := Ptr + 1;
+            Quiet_Output := True;
+
+         --  Processing for Q switch
+
+         when 'Q' =>
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            Ptr := Ptr + 1;
+            Scan_Pos
+              (Switch_Chars, Max, Ptr,
+               Quantity_Of_Default_Size_Sec_Stacks, C);
+
+         --  Processing for r switch
+
+         when 'r' =>
+            Ptr := Ptr + 1;
+            List_Restrictions := True;
+
+         --  Processing for R switch
+
+         when 'R' =>
+            Ptr := Ptr + 1;
+            List_Closure := True;
+
+            if Ptr <= Max and then Switch_Chars (Ptr) = 'a' then
+               Ptr := Ptr + 1;
+               List_Closure_All := True;
+            end if;
+
+         --  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' =>
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            Ptr := Ptr + 1;
+            Time_Slice_Set := True;
+            Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value, C);
+            Time_Slice_Value := Time_Slice_Value * 1_000;
+
+         --  Processing for u switch
+
+         when 'u' =>
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            Ptr := Ptr + 1;
+            Dynamic_Stack_Measurement := True;
+            Scan_Nat
+              (Switch_Chars,
+               Max,
+               Ptr,
+               Dynamic_Stack_Measurement_Array_Size,
+               C);
+
+         --  Processing for v switch
+
+         when 'v' =>
+            Ptr := Ptr + 1;
+            Verbose_Mode := True;
+
+         --  Processing for V switch
+
+         when 'V' =>
+            declare
+               Eq : Integer;
+            begin
+               Ptr := Ptr + 1;
+               Eq := Ptr;
+               while Eq <= Max and then Switch_Chars (Eq) /= '=' loop
+                  Eq := Eq + 1;
+               end loop;
+               if Eq = Ptr or else Eq = Max then
+                  Bad_Switch (Switch_Chars);
+               end if;
+               Bindgen.Set_Bind_Env
+                 (Key   => Switch_Chars (Ptr .. Eq - 1),
+                  Value => Switch_Chars (Eq + 1 .. Max));
+               Ptr := Max + 1;
+            end;
+
+         --  Processing for w switch
+
+         when 'w' =>
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            --  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 'E' =>
+                  Warning_Mode := Treat_Run_Time_Warnings_As_Errors;
+
+               when 's' =>
+                  Warning_Mode := Suppress;
+
+               when others =>
+                  Bad_Switch (Switch_Chars);
+            end case;
+
+            Ptr := Ptr + 1;
+
+         --  Processing for W switch
+
+         when 'W' =>
+            Ptr := Ptr + 1;
+
+            if Ptr > Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            begin
+               Wide_Character_Encoding_Method :=
+                 Get_WC_Encoding_Method (Switch_Chars (Ptr));
+            exception
+               when Constraint_Error =>
+                  Bad_Switch (Switch_Chars);
+            end;
+
+            Wide_Character_Encoding_Method_Specified := True;
+
+            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 X switch
+
+         when 'X' =>
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            Ptr := Ptr + 1;
+            Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status, C);
+
+         --  Processing for y switch
+
+         when 'y' =>
+            Ptr := Ptr + 1;
+            Leap_Seconds_Support := True;
+
+         --  Processing for z switch
+
+         when 'z' =>
+            Ptr := Ptr + 1;
+            No_Main_Subprogram := True;
+
+         --  Processing for Z switch
+
+         when 'Z' =>
+            Ptr := Ptr + 1;
+            Zero_Formatting := True;
+
+         --  Processing for --RTS
+
+         when '-' =>
+
+            if Ptr + 4 <= Max and then
+              Switch_Chars (Ptr + 1 .. Ptr + 3) = "RTS"
+            then
+               Ptr := Ptr + 4;
+
+               if Switch_Chars (Ptr) /= '=' or else Ptr = Max then
+                  Osint.Fail ("missing path for --RTS");
+
+               else
+                  --  Valid --RTS switch
+
+                  Opt.No_Stdinc := True;
+                  Opt.RTS_Switch := True;
+
+                  declare
+                     Src_Path_Name : constant String_Ptr :=
+                                       Get_RTS_Search_Dir
+                                         (Switch_Chars (Ptr + 1 .. Max),
+                                          Include);
+                     Lib_Path_Name : constant String_Ptr :=
+                                       Get_RTS_Search_Dir
+                                         (Switch_Chars (Ptr + 1 .. Max),
+                                          Objects);
+
+                  begin
+                     if Src_Path_Name /= null and then
+                       Lib_Path_Name /= null
+                     then
+                        --  Set the RTS_*_Path_Name variables, so that the
+                        --  correct directories will be set when a subsequent
+                        --  call Osint.Add_Default_Search_Dirs is made.
+
+                        RTS_Src_Path_Name := Src_Path_Name;
+                        RTS_Lib_Path_Name := Lib_Path_Name;
+
+                        Ptr := Max + 1;
+
+                     elsif Src_Path_Name = null
+                       and then 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
+               Bad_Switch (Switch_Chars);
+            end if;
+
+         --  Anything else is an error (illegal switch character)
+
+         when others =>
+            Bad_Switch (Switch_Chars);
+         end case;
+
+         if Ptr <= Max then
+            Bad_Switch (Switch_Chars);
+         end if;
+      end Check_Switch;
+   end Scan_Binder_Switches;
+
+end Switch.B;