Correct a function pre/postcondition [PR102403].

[thirdparty/gcc.git] / gcc / ada / adabkend.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             A D A B K E N D                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2001-2021, AdaCore                     --
--                                                                          --
-- 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.          --
--                                                                          --
------------------------------------------------------------------------------

--  This is the version of the Back_End package for back ends written in Ada

with Atree;    use Atree;
with Debug;
with Lib;
with Opt;      use Opt;
with Output;   use Output;
with Osint;    use Osint;
with Osint.C;  use Osint.C;
with Switch.C; use Switch.C;
with Types;    use Types;

with System.OS_Lib; use System.OS_Lib;

package body Adabkend is

   use Switch;

   -------------------
   -- Call_Back_End --
   -------------------

   procedure Call_Back_End is
   begin
      if (Opt.Verbose_Mode or Opt.Full_List)
        and then not Debug.Debug_Flag_7
      then
         Write_Eol;
         Write_Str (Product_Name);
         Write_Str (", Copyright ");
         Write_Str (Copyright_Years);
         Write_Str (" Ada Core Technologies, Inc.");
         Write_Str (" (http://www.adacore.com)");
         Write_Eol;
         Write_Eol;
      end if;

      --  The front end leaves the Current_Error_Node at a location that is
      --  meaningless and confusing when emitting bug boxes from the back end.
      --  Reset the global variable in order to emit "No source file position
      --  information available" messages on back end crashes.

      Current_Error_Node := Empty;

      Driver (Lib.Cunit (Types.Main_Unit));
   end Call_Back_End;

   -----------------------------
   -- Scan_Compiler_Arguments --
   -----------------------------

   procedure Scan_Compiler_Arguments is
      Output_File_Name_Seen : Boolean := False;
      --  Set to True after having scanned the file_name for switch
      --  "-gnatO file_name"

      Argument_Count : constant Integer := Arg_Count - 1;
      --  Number of arguments (excluding program name)

      Args     : Argument_List (1 .. Argument_Count);
      Next_Arg : Positive := 1;

      procedure Scan_Back_End_Switches (Switch_Chars : String);
      --  Procedure to scan out switches stored in Switch_Chars. The first
      --  character is known to be a valid switch character, and there are no
      --  blanks or other switch terminator characters in the string, so the
      --  entire string should consist of valid switch characters, except that
      --  an optional terminating NUL character is allowed.
      --
      --  If the switch is not valid, control will not return. The switches
      --  must still be scanned to skip the "-o" arguments, or internal GCC
      --  switches, which may be safely ignored by other back ends.

      ----------------------------
      -- Scan_Back_End_Switches --
      ----------------------------

      procedure Scan_Back_End_Switches (Switch_Chars : String) is
         First : constant Positive := Switch_Chars'First + 1;
         Last  : constant Natural  := Switch_Last (Switch_Chars);

      begin
         --  Process any back end switches, returning if the switch does not
         --  affect code generation or falling through if it does, so the
         --  switch will get stored.

         --  Skip -o, -G or internal GCC switches together with their argument.

         if Switch_Chars (First .. Last) = "o"
           or else Switch_Chars (First .. Last) = "G"
           or else Is_Internal_GCC_Switch (Switch_Chars)
         then
            Next_Arg := Next_Arg + 1;
            return; -- ignore this switch

         --  Set optimization indicators appropriately. In gcc-based GNAT this
         --  is picked up from imported variables set by the gcc driver, but
         --  for compilers with non-gcc back ends we do it here to allow use of
         --  these switches by the front end. Allowed optimization switches are
         --  -Os (optimize for size), -O[0123], -O (same as -O1), -Ofast
         --  (disregard strict standards compliance), and -Og (optimize
         --  debugging experience).

         elsif Switch_Chars (First) = 'O' then
            if First = Last then
               Optimization_Level := 1;

            elsif Last - First = 1 then
               if Switch_Chars (Last) = 's' then
                  Optimize_Size := 1;
                  Optimization_Level := 2;  -- Consistent with gcc setting

               elsif Switch_Chars (Last) in '0' .. '3' then
                  Optimization_Level :=
                    Character'Pos (Switch_Chars (Last)) - Character'Pos ('0');

               --  Switch -Og is between -O0 and -O1 in GCC. Consider it like
               --  -O0 for other back ends.

               elsif Switch_Chars (Last) = 'g' then
                  Optimization_Level := 0;

               else
                  Fail ("invalid switch: " & Switch_Chars);
               end if;

            --  Switch -Ofast enables -O3

            elsif Switch_Chars (First + 1 .. Last) = "fast" then
               Optimization_Level := 3;

            else
               Fail ("invalid switch: " & Switch_Chars);
            end if;

         elsif Switch_Chars (First .. Last) = "quiet" then
            return; -- ignore this switch

         elsif Switch_Chars (First .. Last) = "c" then
            return; -- ignore this switch

         --  The -x switch and its language name argument will generally be
         --  ignored by non-gcc back ends. In any case, we save the switch and
         --  argument in the compilation switches.

         elsif Switch_Chars (First .. Last) = "x" then
            Lib.Store_Compilation_Switch (Switch_Chars);
            Next_Arg := Next_Arg + 1;

            declare
               Argv : constant String := Args (Next_Arg).all;

            begin
               if Is_Switch (Argv) then
                  Fail ("language name missing after -x");
               else
                  Lib.Store_Compilation_Switch (Argv);
               end if;
            end;

            return;

         --  Special check, the back-end switch -fno-inline also sets the
         --  front end flags to entirely inhibit all inlining. So we store it
         --  and set the appropriate flags.

         elsif Switch_Chars (First .. Last) = "fno-inline" then
            Lib.Store_Compilation_Switch (Switch_Chars);
            Opt.Disable_FE_Inline := True;
            return;

         --  Similar processing for -fpreserve-control-flow

         elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then
            Lib.Store_Compilation_Switch (Switch_Chars);
            Opt.Suppress_Control_Flow_Optimizations := True;
            return;

         --  Recognize -gxxx switches

         elsif Switch_Chars (First) = 'g' then
            Debugger_Level := 2;

            if First < Last then
               case Switch_Chars (First + 1) is
                  when '0' =>
                     Debugger_Level := 0;
                  when '1' =>
                     Debugger_Level := 1;
                  when '2' =>
                     Debugger_Level := 2;
                  when '3' =>
                     Debugger_Level := 3;
                  when others =>
                     null;
               end case;
            end if;

         elsif Switch_Chars (First .. Last) = "S" then
            Generate_Asm := True;

         --  Ignore all other back-end switches

         elsif Is_Back_End_Switch (Switch_Chars) then
            null;

         --  Give error for junk switch

         else
            Fail ("invalid switch: " & Switch_Chars);
         end if;

         --  Store any other GCC switches

         Lib.Store_Compilation_Switch (Switch_Chars);
      end Scan_Back_End_Switches;

   --  Start of processing for Scan_Compiler_Args

   begin
      --  Put all the arguments in argument list Args

      for Arg in 1 .. Argument_Count loop
         declare
            Argv : String (1 .. Len_Arg (Arg));
         begin
            Fill_Arg (Argv'Address, Arg);
            Args (Arg) := new String'(Argv);
         end;
      end loop;

      --  Loop through command line arguments, storing them for later access

      while Next_Arg <= Argument_Count loop
         Look_At_Arg : declare
            Argv : constant String := Args (Next_Arg).all;

         begin
            if Argv'Length = 0 then
               Fail ("Empty argument");
            end if;

            --  If the previous switch has set the Output_File_Name_Present
            --  flag (that is we have seen a -gnatO), then the next argument
            --  is the name of the output object file.

            if Opt.Output_File_Name_Present
              and then not Output_File_Name_Seen
            then
               if Is_Switch (Argv) then
                  Fail ("Object file name missing after -gnatO");
               else
                  Set_Output_Object_File_Name (Argv);
                  Output_File_Name_Seen := True;
               end if;

               --  If the previous switch has set the Search_Directory_Present
               --  flag (that is if we have just seen -I), then the next
               --  argument is a search directory path.

            elsif Search_Directory_Present then
               if Is_Switch (Argv) then
                  Fail ("search directory missing after -I");
               else
                  Add_Src_Search_Dir (Argv);

                  --  Add directory to lib search so that back end can take as
                  --  input ALI files if needed. Otherwise this won't have any
                  --  impact on the compiler.

                  Add_Lib_Search_Dir (Argv);

                  Search_Directory_Present := False;
               end if;

            --  If not a switch, must be a file name

            elsif not Is_Switch (Argv) then
               Add_File (Argv);

            --  We must recognize -nostdinc to suppress visibility on the
            --  standard GNAT RTL sources.

            elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
               Opt.No_Stdinc := True;

            --  Front end switch

            elsif Is_Front_End_Switch (Argv) then
               Scan_Front_End_Switches (Argv, Args, Next_Arg);

            --  All non-front-end switches are back-end switches

            else
               Scan_Back_End_Switches (Argv);
            end if;
         end Look_At_Arg;

         Next_Arg := Next_Arg + 1;
      end loop;
   end Scan_Compiler_Arguments;

end Adabkend;