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 --                            $Revision: 1.23 $
  10 --                                                                          --
  11 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Atree;   use Atree;
  30 with Debug;   use Debug;
  31 with Elists;  use Elists;
  32 with Lib;     use Lib;
  33 with Osint;   use Osint;
  34 with Opt;     use Opt;
  35 with Osint;   use Osint;
  36 with Namet;   use Namet;
  37 with Nlists;  use Nlists;
  38 with Stand;   use Stand;
  39 with Sinput;  use Sinput;
  40 with Stringt; use Stringt;
  41 with Switch;  use Switch;
  42 with System;  use System;
  43 with Types;   use Types;
  44
  45 package body Back_End is
  46
  47    --  Local subprograms
  48
  49    -------------------
  50    -- Call_Back_End --
  51    -------------------
  52
  53    procedure Call_Back_End (Mode : Back_End_Mode_Type) is
  54
  55       --  The File_Record type has a lot of components that are meaningless
  56       --  to the back end, so a new record is created here to contain the
  57       --  needed information for each file.
  58
  59       type Needed_File_Info_Type is record
  60          File_Name        : File_Name_Type;
  61          First_Sloc       : Source_Ptr;
  62          Last_Sloc        : Source_Ptr;
  63          Num_Source_Lines : Nat;
  64       end record;
  65
  66       File_Info_Array :
  67         array (Main_Unit .. Last_Unit) of Needed_File_Info_Type;
  68
  69       procedure gigi (
  70          gnat_root                     : Int;
  71          max_gnat_node                 : Int;
  72          number_name                   : Nat;
  73          nodes_ptr                     : Address;
  74
  75          next_node_ptr                 : Address;
  76          prev_node_ptr                 : Address;
  77          elists_ptr                    : Address;
  78          elmts_ptr                     : Address;
  79
  80          strings_ptr                   : Address;
  81          string_chars_ptr              : Address;
  82          list_headers_ptr              : Address;
  83          number_units                  : Int;
  84
  85          file_info_ptr                 : Address;
  86          gigi_standard_integer         : Entity_Id;
  87          gigi_standard_long_long_float : Entity_Id;
  88          gigi_standard_exception_type  : Entity_Id;
  89          gigi_operating_mode           : Back_End_Mode_Type);
  90
  91       pragma Import (C, gigi);
  92
  93       S : Source_File_Index;
  94
  95    begin
  96       --  Skip call if in -gnatdH mode
  97
  98       if Debug_Flag_HH then
  99          return;
 100       end if;
 101
 102       for J in Main_Unit .. Last_Unit loop
 103          S := Source_Index (J);
 104          File_Info_Array (J).File_Name        := File_Name (S);
 105          File_Info_Array (J).First_Sloc       := Source_Text (S)'First;
 106          File_Info_Array (J).Last_Sloc        := Source_Text (S)'Last;
 107          File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (S);
 108       end loop;
 109
 110       gigi (
 111          gnat_root          => Int (Cunit (Main_Unit)),
 112          max_gnat_node      => Int (Last_Node_Id - First_Node_Id + 1),
 113          number_name        => Name_Entries_Count,
 114          nodes_ptr          => Nodes_Address,
 115
 116          next_node_ptr      => Next_Node_Address,
 117          prev_node_ptr      => Prev_Node_Address,
 118          elists_ptr         => Elists_Address,
 119          elmts_ptr          => Elmts_Address,
 120
 121          strings_ptr        => Strings_Address,
 122          string_chars_ptr   => String_Chars_Address,
 123          list_headers_ptr   => Lists_Address,
 124          number_units       => Num_Units,
 125
 126          file_info_ptr                 => File_Info_Array'Address,
 127          gigi_standard_integer         => Standard_Integer,
 128          gigi_standard_long_long_float => Standard_Long_Long_Float,
 129          gigi_standard_exception_type  => Standard_Exception_Type,
 130          gigi_operating_mode           => Mode);
 131    end Call_Back_End;
 132
 133    -----------------------------
 134    -- Scan_Compiler_Arguments --
 135    -----------------------------
 136
 137    procedure Scan_Compiler_Arguments is
 138
 139       Next_Arg : Pos := 1;
 140
 141       subtype Big_String is String (Positive);
 142       type BSP is access Big_String;
 143
 144       type Arg_Array is array (Nat) of BSP;
 145       type Arg_Array_Ptr is access Arg_Array;
 146
 147       --  Import flag_stack_check from toplev.c.
 148
 149       flag_stack_check : Int;
 150       pragma Import (C, flag_stack_check); -- Import from toplev.c
 151
 152       save_argc : Nat;
 153       pragma Import (C, save_argc); -- Import from toplev.c
 154
 155       save_argv : Arg_Array_Ptr;
 156       pragma Import (C, save_argv); -- Import from toplev.c
 157
 158       Output_File_Name_Seen : Boolean := False;
 159       --  Set to True after having scanned the file_name for
 160       --  switch "-gnatO file_name"
 161
 162       --  Local functions
 163
 164       function Len_Arg (Arg : Pos) return Nat;
 165       --  Determine length of argument number Arg on the original
 166       --  command line from gnat1
 167
 168       procedure Scan_Back_End_Switches (Switch_Chars : String);
 169       --  Procedure to scan out switches stored in Switch_Chars. The first
 170       --  character is known to be a valid switch character, and there are no
 171       --  blanks or other switch terminator characters in the string, so the
 172       --  entire string should consist of valid switch characters, except that
 173       --  an optional terminating NUL character is allowed.
 174       --
 175       --  Back end switches have already been checked and processed by GCC
 176       --  in toplev.c, so no errors can occur and control will always return.
 177       --  The switches must still be scanned to skip the arguments of the
 178       --  "-o" or the (undocumented) "-dumpbase" switch, by incrementing
 179       --  the Next_Arg variable. The "-dumpbase" switch is used to set the
 180       --  basename for GCC dumpfiles.
 181
 182       -------------
 183       -- Len_Arg --
 184       -------------
 185
 186       function Len_Arg (Arg : Pos) return Nat is
 187       begin
 188          for J in 1 .. Nat'Last loop
 189             if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
 190                return J - 1;
 191             end if;
 192          end loop;
 193
 194          raise Program_Error;
 195       end Len_Arg;
 196
 197       ----------------------------
 198       -- Scan_Back_End_Switches --
 199       ----------------------------
 200
 201       procedure Scan_Back_End_Switches (Switch_Chars : String) is
 202          First : constant Positive := Switch_Chars'First + 1;
 203          Last  : Natural := Switch_Chars'Last;
 204
 205       begin
 206          if Last >= First
 207            and then Switch_Chars (Last) = ASCII.NUL
 208          then
 209             Last := Last - 1;
 210          end if;
 211
 212          if Switch_Chars (First .. Last) = "o"
 213             or else Switch_Chars (First .. Last) = "dumpbase"
 214
 215          then
 216             Next_Arg := Next_Arg + 1;
 217
 218          elsif Switch_Chars (First .. Last) = "quiet" then
 219             null; -- do not record this switch
 220
 221          else
 222             --  Store any other GCC switches
 223             Store_Compilation_Switch (Switch_Chars);
 224          end if;
 225       end Scan_Back_End_Switches;
 226
 227    --  Start of processing for Scan_Compiler_Arguments
 228
 229    begin
 230       --  Acquire stack checking mode directly from GCC
 231
 232       Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
 233
 234       --  Loop through command line arguments, storing them for later access
 235
 236       while Next_Arg < save_argc loop
 237
 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      : 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             elsif not Is_Switch (Argv) then -- must be a file name
 260                Add_File (Argv);
 261
 262             elsif Is_Front_End_Switch (Argv) then
 263                Scan_Front_End_Switches (Argv);
 264
 265                --  ??? Should be done in Scan_Front_End_Switches, after
 266                --      Switch is splitted in compiler/make/bind units
 267
 268                if Argv (2) /= 'I' then
 269                   Store_Compilation_Switch (Argv);
 270                end if;
 271
 272             --  All non-front-end switches are back-end switches
 273
 274             else
 275                Scan_Back_End_Switches (Argv);
 276             end if;
 277          end Look_At_Arg;
 278
 279          Next_Arg := Next_Arg + 1;
 280       end loop;
 281    end Scan_Compiler_Arguments;
 282
 283 end Back_End;