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