gcc/ada/back_end.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                            B A C K _ E N D                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Atree;     use Atree;
  27 with Debug;     use Debug;
  28 with Elists;    use Elists;
  29 with Lib;       use Lib;
  30 with Osint;     use Osint;
  31 with Opt;       use Opt;
  32 with Osint.C;   use Osint.C;
  33 with Namet;     use Namet;
  34 with Nlists;    use Nlists;
  35 with Stand;     use Stand;
  36 with Sinput;    use Sinput;
  37 with Stringt;   use Stringt;
  38 with Switch;    use Switch;
  39 with Switch.C;  use Switch.C;
  40 with System;    use System;
  41 with Types;     use Types;
  42
  43 package body Back_End is
  44
  45    type Arg_Array is array (Nat) of Big_String_Ptr;
  46    type Arg_Array_Ptr is access Arg_Array;
  47    --  Types to access compiler arguments
  48
  49    flag_stack_check : Int;
  50    pragma Import (C, flag_stack_check);
  51    --  Indicates if stack checking is enabled, imported from toplev.c
  52
  53    save_argc : Nat;
  54    pragma Import (C, save_argc);
  55    --  Saved value of argc (number of arguments), imported from toplev.c
  56
  57    save_argv : Arg_Array_Ptr;
  58    pragma Import (C, save_argv);
  59    --  Saved value of argv (argument pointers), imported from toplev.c
  60
  61    function Len_Arg (Arg : Pos) return Nat;
  62    --  Determine length of argument number Arg on original gnat1 command line
  63
  64    -------------------
  65    -- Call_Back_End --
  66    -------------------
  67
  68    procedure Call_Back_End (Mode : Back_End_Mode_Type) is
  69
  70       --  The Source_File_Record type has a lot of components that are
  71       --  meaningless to the back end, so a new record type is created
  72       --  here to contain the needed information for each file.
  73
  74       type File_Info_Type is record
  75          File_Name        : File_Name_Type;
  76          Num_Source_Lines : Nat;
  77       end record;
  78
  79       File_Info_Array : array (1 .. Last_Source_File) of File_Info_Type;
  80
  81       procedure gigi
  82         (gnat_root                     : Int;
  83          max_gnat_node                 : Int;
  84          number_name                   : Nat;
  85          nodes_ptr                     : Address;
  86
  87          next_node_ptr                 : Address;
  88          prev_node_ptr                 : Address;
  89          elists_ptr                    : Address;
  90          elmts_ptr                     : Address;
  91
  92          strings_ptr                   : Address;
  93          string_chars_ptr              : Address;
  94          list_headers_ptr              : Address;
  95          number_file                   : Nat;
  96
  97          file_info_ptr                 : Address;
  98          gigi_standard_boolean         : Entity_Id;
  99          gigi_standard_integer         : Entity_Id;
 100          gigi_standard_character       : Entity_Id;
 101          gigi_standard_long_long_float : Entity_Id;
 102          gigi_standard_exception_type  : Entity_Id;
 103          gigi_operating_mode           : Back_End_Mode_Type);
 104
 105       pragma Import (C, gigi);
 106
 107    begin
 108       --  Skip call if in -gnatdH mode
 109
 110       if Debug_Flag_HH then
 111          return;
 112       end if;
 113
 114       for J in 1 .. Last_Source_File loop
 115          File_Info_Array (J).File_Name        := Full_Debug_Name (J);
 116          File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (J);
 117       end loop;
 118
 119       gigi
 120         (gnat_root          => Int (Cunit (Main_Unit)),
 121          max_gnat_node      => Int (Last_Node_Id - First_Node_Id + 1),
 122          number_name        => Name_Entries_Count,
 123          nodes_ptr          => Nodes_Address,
 124
 125          next_node_ptr      => Next_Node_Address,
 126          prev_node_ptr      => Prev_Node_Address,
 127          elists_ptr         => Elists_Address,
 128          elmts_ptr          => Elmts_Address,
 129
 130          strings_ptr        => Strings_Address,
 131          string_chars_ptr   => String_Chars_Address,
 132          list_headers_ptr   => Lists_Address,
 133          number_file        => Num_Source_Files,
 134
 135          file_info_ptr                 => File_Info_Array'Address,
 136          gigi_standard_boolean         => Standard_Boolean,
 137          gigi_standard_integer         => Standard_Integer,
 138          gigi_standard_character       => Standard_Character,
 139          gigi_standard_long_long_float => Standard_Long_Long_Float,
 140          gigi_standard_exception_type  => Standard_Exception_Type,
 141          gigi_operating_mode           => Mode);
 142    end Call_Back_End;
 143
 144    -------------
 145    -- Len_Arg --
 146    -------------
 147
 148    function Len_Arg (Arg : Pos) return Nat is
 149    begin
 150       for J in 1 .. Nat'Last loop
 151          if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
 152             return J - 1;
 153          end if;
 154       end loop;
 155
 156       raise Program_Error;
 157    end Len_Arg;
 158
 159    -----------------------------
 160    -- Scan_Compiler_Arguments --
 161    -----------------------------
 162
 163    procedure Scan_Compiler_Arguments is
 164
 165       Next_Arg : Pos;
 166       --  Next argument to be scanned
 167
 168       Output_File_Name_Seen : Boolean := False;
 169       --  Set to True after having scanned file_name for switch "-gnatO file"
 170
 171       procedure Scan_Back_End_Switches (Switch_Chars : String);
 172       --  Procedure to scan out switches stored in Switch_Chars. The first
 173       --  character is known to be a valid switch character, and there are no
 174       --  blanks or other switch terminator characters in the string, so the
 175       --  entire string should consist of valid switch characters, except that
 176       --  an optional terminating NUL character is allowed.
 177       --
 178       --  Back end switches have already been checked and processed by GCC in
 179       --  toplev.c, so no errors can occur and control will always return. The
 180       --  switches must still be scanned to skip "-o" or internal GCC switches
 181       --  with their argument.
 182
 183       ----------------------------
 184       -- Scan_Back_End_Switches --
 185       ----------------------------
 186
 187       procedure Scan_Back_End_Switches (Switch_Chars : String) is
 188          First : constant Positive := Switch_Chars'First + 1;
 189          Last  : constant Natural  := Switch_Last (Switch_Chars);
 190
 191       begin
 192          --  Skip -o or internal GCC switches together with their argument
 193
 194          if Switch_Chars (First .. Last) = "o"
 195            or else Is_Internal_GCC_Switch (Switch_Chars)
 196          then
 197             Next_Arg := Next_Arg + 1;
 198
 199          --  Do not record -quiet switch
 200
 201          elsif Switch_Chars (First .. Last) = "quiet" then
 202             null;
 203
 204          --  Store any other GCC switches
 205
 206          else
 207             Store_Compilation_Switch (Switch_Chars);
 208
 209             --  Special check, the back end switch -fno-inline also sets the
 210             --  front end flag to entirely inhibit all inlining.
 211
 212             if Switch_Chars (First .. Last) = "fno-inline" then
 213                Opt.Suppress_All_Inlining := True;
 214
 215             --  Another special check, the switch -fpreserve-control-flow
 216             --  which is also a back end switch sets the front end flag
 217             --  that inhibits improper control flow transformations.
 218
 219             elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then
 220                Opt.Suppress_Control_Flow_Optimizations := True;
 221             end if;
 222          end if;
 223       end Scan_Back_End_Switches;
 224
 225    --  Start of processing for Scan_Compiler_Arguments
 226
 227    begin
 228       --  Acquire stack checking mode directly from GCC
 229
 230       Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
 231
 232       --  Loop through command line arguments, storing them for later access
 233
 234       Next_Arg := 1;
 235       while Next_Arg < save_argc loop
 236          Look_At_Arg : declare
 237             Argv_Ptr : constant Big_String_Ptr := save_argv (Next_Arg);
 238             Argv_Len : constant Nat            := Len_Arg (Next_Arg);
 239             Argv     : constant String         :=
 240                          Argv_Ptr (1 .. Natural (Argv_Len));
 241
 242          begin
 243             --  If the previous switch has set the Output_File_Name_Present
 244             --  flag (that is we have seen a -gnatO), then the next argument
 245             --  is the name of the output object file.
 246
 247             if Output_File_Name_Present
 248               and then not Output_File_Name_Seen
 249             then
 250                if Is_Switch (Argv) then
 251                   Fail ("Object file name missing after -gnatO");
 252
 253                else
 254                   Set_Output_Object_File_Name (Argv);
 255                   Output_File_Name_Seen := True;
 256                end if;
 257
 258             --  If the previous switch has set the Search_Directory_Present
 259             --  flag (that is if we have just seen -I), then the next argument
 260             --  is a search directory path.
 261
 262             elsif Search_Directory_Present then
 263                if Is_Switch (Argv) then
 264                   Fail ("search directory missing after -I");
 265                else
 266                   Add_Src_Search_Dir (Argv);
 267                   Search_Directory_Present := False;
 268                end if;
 269
 270             elsif not Is_Switch (Argv) then -- must be a file name
 271                Add_File (Argv);
 272
 273             --  We must recognize -nostdinc to suppress visibility on the
 274             --  standard GNAT RTL sources. This is also a gcc switch.
 275
 276             elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
 277                Opt.No_Stdinc := True;
 278                Scan_Back_End_Switches (Argv);
 279
 280             --  We must recognize -nostdlib to suppress visibility on the
 281             --  standard GNAT RTL objects.
 282
 283             elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
 284                Opt.No_Stdlib := True;
 285
 286             elsif Is_Front_End_Switch (Argv) then
 287                Scan_Front_End_Switches (Argv, Next_Arg);
 288
 289             --  All non-front-end switches are back-end switches
 290
 291             else
 292                Scan_Back_End_Switches (Argv);
 293             end if;
 294          end Look_At_Arg;
 295
 296          Next_Arg := Next_Arg + 1;
 297       end loop;
 298    end Scan_Compiler_Arguments;
 299 end Back_End;