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-2007, 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    -------------------
  46    -- Call_Back_End --
  47    -------------------
  48
  49    procedure Call_Back_End (Mode : Back_End_Mode_Type) is
  50
  51       --  The Source_File_Record type has a lot of components that are
  52       --  meaningless to the back end, so a new record type is created
  53       --  here to contain the needed information for each file.
  54
  55       type File_Info_Type is record
  56          File_Name        : File_Name_Type;
  57          Num_Source_Lines : Nat;
  58       end record;
  59
  60       File_Info_Array : array (1 .. Last_Source_File) of File_Info_Type;
  61
  62       procedure gigi (
  63          gnat_root                     : Int;
  64          max_gnat_node                 : Int;
  65          number_name                   : Nat;
  66          nodes_ptr                     : Address;
  67
  68          next_node_ptr                 : Address;
  69          prev_node_ptr                 : Address;
  70          elists_ptr                    : Address;
  71          elmts_ptr                     : Address;
  72
  73          strings_ptr                   : Address;
  74          string_chars_ptr              : Address;
  75          list_headers_ptr              : Address;
  76          number_file                   : Nat;
  77
  78          file_info_ptr                 : Address;
  79          gigi_standard_integer         : Entity_Id;
  80          gigi_standard_long_long_float : Entity_Id;
  81          gigi_standard_exception_type  : Entity_Id;
  82          gigi_operating_mode           : Back_End_Mode_Type);
  83
  84       pragma Import (C, gigi);
  85
  86    begin
  87       --  Skip call if in -gnatdH mode
  88
  89       if Debug_Flag_HH then
  90          return;
  91       end if;
  92
  93       for I in 1 .. Last_Source_File loop
  94          File_Info_Array (I).File_Name        := Full_Debug_Name (I);
  95          File_Info_Array (I).Num_Source_Lines := Num_Source_Lines (I);
  96       end loop;
  97
  98       gigi (
  99          gnat_root          => Int (Cunit (Main_Unit)),
 100          max_gnat_node      => Int (Last_Node_Id - First_Node_Id + 1),
 101          number_name        => Name_Entries_Count,
 102          nodes_ptr          => Nodes_Address,
 103
 104          next_node_ptr      => Next_Node_Address,
 105          prev_node_ptr      => Prev_Node_Address,
 106          elists_ptr         => Elists_Address,
 107          elmts_ptr          => Elmts_Address,
 108
 109          strings_ptr        => Strings_Address,
 110          string_chars_ptr   => String_Chars_Address,
 111          list_headers_ptr   => Lists_Address,
 112          number_file        => Num_Source_Files,
 113
 114          file_info_ptr                 => File_Info_Array'Address,
 115          gigi_standard_integer         => Standard_Integer,
 116          gigi_standard_long_long_float => Standard_Long_Long_Float,
 117          gigi_standard_exception_type  => Standard_Exception_Type,
 118          gigi_operating_mode           => Mode);
 119    end Call_Back_End;
 120
 121    -----------------------------
 122    -- Scan_Compiler_Arguments --
 123    -----------------------------
 124
 125    procedure Scan_Compiler_Arguments is
 126       Next_Arg : Pos := 1;
 127
 128       subtype Big_String is String (Positive);
 129       type BSP is access Big_String;
 130
 131       type Arg_Array is array (Nat) of BSP;
 132       type Arg_Array_Ptr is access Arg_Array;
 133
 134       --  Import flag_stack_check from toplev.c
 135
 136       flag_stack_check : Int;
 137       pragma Import (C, flag_stack_check); -- Import from toplev.c
 138
 139       save_argc : Nat;
 140       pragma Import (C, save_argc); -- Import from toplev.c
 141
 142       save_argv : Arg_Array_Ptr;
 143       pragma Import (C, save_argv); -- Import from toplev.c
 144
 145       Output_File_Name_Seen : Boolean := False;
 146       --  Set to True after having scanned the file_name for
 147       --  switch "-gnatO file_name"
 148
 149       --  Local functions
 150
 151       function Len_Arg (Arg : Pos) return Nat;
 152       --  Determine length of argument number Arg on the original
 153       --  command line from gnat1
 154
 155       procedure Scan_Back_End_Switches (Switch_Chars : String);
 156       --  Procedure to scan out switches stored in Switch_Chars. The first
 157       --  character is known to be a valid switch character, and there are no
 158       --  blanks or other switch terminator characters in the string, so the
 159       --  entire string should consist of valid switch characters, except that
 160       --  an optional terminating NUL character is allowed.
 161       --
 162       --  Back end switches have already been checked and processed by GCC
 163       --  in toplev.c, so no errors can occur and control will always return.
 164       --  The switches must still be scanned to skip the arguments of the
 165       --  "-o" or the (undocumented) "-dumpbase" switch, by incrementing
 166       --  the Next_Arg variable. The "-dumpbase" switch is used to set the
 167       --  basename for GCC dumpfiles.
 168
 169       -------------
 170       -- Len_Arg --
 171       -------------
 172
 173       function Len_Arg (Arg : Pos) return Nat is
 174       begin
 175          for J in 1 .. Nat'Last loop
 176             if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
 177                return J - 1;
 178             end if;
 179          end loop;
 180
 181          raise Program_Error;
 182       end Len_Arg;
 183
 184       ----------------------------
 185       -- Scan_Back_End_Switches --
 186       ----------------------------
 187
 188       procedure Scan_Back_End_Switches (Switch_Chars : String) is
 189          First : constant Positive := Switch_Chars'First + 1;
 190          Last  : Natural := Switch_Chars'Last;
 191
 192       begin
 193          if Last >= First
 194            and then Switch_Chars (Last) = ASCII.NUL
 195          then
 196             Last := Last - 1;
 197          end if;
 198
 199          --  For these switches, skip following argument and do not
 200          --  store either the switch or the following argument
 201
 202          if Switch_Chars (First .. Last) = "o"
 203             or else Switch_Chars (First .. Last) = "dumpbase"
 204             or else Switch_Chars (First .. Last) = "-param"
 205
 206          then
 207             Next_Arg := Next_Arg + 1;
 208
 209          --  Do not record -quiet switch
 210
 211          elsif Switch_Chars (First .. Last) = "quiet" then
 212             null;
 213
 214          else
 215             --  Store any other GCC switches
 216
 217             Store_Compilation_Switch (Switch_Chars);
 218
 219             --  Special check, the back end switch -fno-inline also sets the
 220             --  front end flag to entirely inhibit all inlining.
 221
 222             if Switch_Chars (First .. Last) = "fno-inline" then
 223                Opt.Suppress_All_Inlining := True;
 224             end if;
 225          end if;
 226       end Scan_Back_End_Switches;
 227
 228    --  Start of processing for Scan_Compiler_Arguments
 229
 230    begin
 231       --  Acquire stack checking mode directly from GCC
 232
 233       Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
 234
 235       --  Loop through command line arguments, storing them for later access
 236
 237       while Next_Arg < save_argc loop
 238          Look_At_Arg : declare
 239             Argv_Ptr : constant BSP    := save_argv (Next_Arg);
 240             Argv_Len : constant Nat    := Len_Arg (Next_Arg);
 241             Argv     : constant String := Argv_Ptr (1 .. Natural (Argv_Len));
 242
 243          begin
 244             --  If the previous switch has set the Output_File_Name_Present
 245             --  flag (that is we have seen a -gnatO), then the next argument
 246             --  is the name of the output object file.
 247
 248             if Output_File_Name_Present
 249               and then not Output_File_Name_Seen
 250             then
 251                if Is_Switch (Argv) then
 252                   Fail ("Object file name missing after -gnatO");
 253
 254                else
 255                   Set_Output_Object_File_Name (Argv);
 256                   Output_File_Name_Seen := True;
 257                end if;
 258
 259                --  If the previous switch has set the Search_Directory_Present
 260                --  flag (that is if we have just seen -I), then the next
 261                --  argument is a search directory path.
 262
 263             elsif Search_Directory_Present then
 264                if Is_Switch (Argv) then
 265                   Fail ("search directory missing after -I");
 266                else
 267                   Add_Src_Search_Dir (Argv);
 268                   Search_Directory_Present := False;
 269                end if;
 270
 271             elsif not Is_Switch (Argv) then -- must be a file name
 272                Add_File (Argv);
 273
 274             --  We must recognize -nostdinc to suppress visibility on the
 275             --  standard GNAT RTL sources. This is also a gcc switch.
 276
 277             elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
 278                Opt.No_Stdinc := True;
 279                Scan_Back_End_Switches (Argv);
 280
 281             --  We must recognize -nostdlib to suppress visibility on the
 282             --  standard GNAT RTL objects.
 283
 284             elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
 285                Opt.No_Stdlib := True;
 286
 287             elsif Is_Front_End_Switch (Argv) then
 288                Scan_Front_End_Switches (Argv);
 289
 290             --  All non-front-end switches are back-end switches
 291
 292             else
 293                Scan_Back_End_Switches (Argv);
 294             end if;
 295          end Look_At_Arg;
 296
 297          Next_Arg := Next_Arg + 1;
 298       end loop;
 299    end Scan_Compiler_Arguments;
 300
 301 end Back_End;