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-2012, 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 Errout;    use Errout;
  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 with System.OS_Lib; use System.OS_Lib;
  45
  46 package body Back_End is
  47
  48    type Arg_Array is array (Nat) of Big_String_Ptr;
  49    type Arg_Array_Ptr is access Arg_Array;
  50    --  Types to access compiler arguments
  51
  52    flag_stack_check : Int;
  53    pragma Import (C, flag_stack_check);
  54    --  Indicates if stack checking is enabled, imported from decl.c
  55
  56    save_argc : Nat;
  57    pragma Import (C, save_argc);
  58    --  Saved value of argc (number of arguments), imported from misc.c
  59
  60    save_argv : Arg_Array_Ptr;
  61    pragma Import (C, save_argv);
  62    --  Saved value of argv (argument pointers), imported from misc.c
  63
  64    function Len_Arg (Arg : Pos) return Nat;
  65    --  Determine length of argument number Arg on original gnat1 command line
  66
  67    -------------------
  68    -- Call_Back_End --
  69    -------------------
  70
  71    procedure Call_Back_End (Mode : Back_End_Mode_Type) is
  72
  73       --  The Source_File_Record type has a lot of components that are
  74       --  meaningless to the back end, so a new record type is created
  75       --  here to contain the needed information for each file.
  76
  77       type File_Info_Type is record
  78          File_Name        : File_Name_Type;
  79          Instance         : Instance_Id;
  80          Num_Source_Lines : Nat;
  81       end record;
  82
  83       File_Info_Array : array (1 .. Last_Source_File) of File_Info_Type;
  84
  85       procedure gigi
  86         (gnat_root                     : Int;
  87          max_gnat_node                 : Int;
  88          number_name                   : Nat;
  89          nodes_ptr                     : Address;
  90
  91          next_node_ptr                 : Address;
  92          prev_node_ptr                 : Address;
  93          elists_ptr                    : Address;
  94          elmts_ptr                     : Address;
  95
  96          strings_ptr                   : Address;
  97          string_chars_ptr              : Address;
  98          list_headers_ptr              : Address;
  99          number_file                   : Nat;
 100
 101          file_info_ptr                 : Address;
 102          gigi_standard_boolean         : Entity_Id;
 103          gigi_standard_integer         : Entity_Id;
 104          gigi_standard_character       : Entity_Id;
 105          gigi_standard_long_long_float : Entity_Id;
 106          gigi_standard_exception_type  : Entity_Id;
 107          gigi_operating_mode           : Back_End_Mode_Type);
 108
 109       pragma Import (C, gigi);
 110
 111    begin
 112       --  Skip call if in -gnatdH mode
 113
 114       if Debug_Flag_HH then
 115          return;
 116       end if;
 117
 118       --  The back end needs to know the maximum line number that can appear
 119       --  in a Sloc, in other words the maximum logical line number.
 120
 121       for J in 1 .. Last_Source_File loop
 122          File_Info_Array (J).File_Name        := Full_Debug_Name (J);
 123          File_Info_Array (J).Instance         := Instance (J);
 124          File_Info_Array (J).Num_Source_Lines :=
 125            Nat (Physical_To_Logical (Last_Source_Line (J), J));
 126       end loop;
 127
 128       if Generate_SCIL then
 129          Error_Msg_N ("'S'C'I'L generation not available", Cunit (Main_Unit));
 130
 131          if CodePeer_Mode
 132            or else (Mode /= Generate_Object
 133                      and then not Back_Annotate_Rep_Info)
 134          then
 135             return;
 136          end if;
 137       end if;
 138
 139       gigi
 140         (gnat_root          => Int (Cunit (Main_Unit)),
 141          max_gnat_node      => Int (Last_Node_Id - First_Node_Id + 1),
 142          number_name        => Name_Entries_Count,
 143          nodes_ptr          => Nodes_Address,
 144
 145          next_node_ptr      => Next_Node_Address,
 146          prev_node_ptr      => Prev_Node_Address,
 147          elists_ptr         => Elists_Address,
 148          elmts_ptr          => Elmts_Address,
 149
 150          strings_ptr        => Strings_Address,
 151          string_chars_ptr   => String_Chars_Address,
 152          list_headers_ptr   => Lists_Address,
 153          number_file        => Num_Source_Files,
 154
 155          file_info_ptr                 => File_Info_Array'Address,
 156          gigi_standard_boolean         => Standard_Boolean,
 157          gigi_standard_integer         => Standard_Integer,
 158          gigi_standard_character       => Standard_Character,
 159          gigi_standard_long_long_float => Standard_Long_Long_Float,
 160          gigi_standard_exception_type  => Standard_Exception_Type,
 161          gigi_operating_mode           => Mode);
 162    end Call_Back_End;
 163
 164    -------------
 165    -- Len_Arg --
 166    -------------
 167
 168    function Len_Arg (Arg : Pos) return Nat is
 169    begin
 170       for J in 1 .. Nat'Last loop
 171          if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
 172             return J - 1;
 173          end if;
 174       end loop;
 175
 176       raise Program_Error;
 177    end Len_Arg;
 178
 179    -----------------------------
 180    -- Scan_Compiler_Arguments --
 181    -----------------------------
 182
 183    procedure Scan_Compiler_Arguments is
 184
 185       Next_Arg : Positive;
 186       --  Next argument to be scanned
 187
 188       Output_File_Name_Seen : Boolean := False;
 189       --  Set to True after having scanned file_name for switch "-gnatO file"
 190
 191       procedure Scan_Back_End_Switches (Switch_Chars : String);
 192       --  Procedure to scan out switches stored in Switch_Chars. The first
 193       --  character is known to be a valid switch character, and there are no
 194       --  blanks or other switch terminator characters in the string, so the
 195       --  entire string should consist of valid switch characters, except that
 196       --  an optional terminating NUL character is allowed.
 197       --
 198       --  Back end switches have already been checked and processed by GCC in
 199       --  toplev.c, so no errors can occur and control will always return. The
 200       --  switches must still be scanned to skip "-o" or internal GCC switches
 201       --  with their argument.
 202
 203       ----------------------------
 204       -- Scan_Back_End_Switches --
 205       ----------------------------
 206
 207       procedure Scan_Back_End_Switches (Switch_Chars : String) is
 208          First : constant Positive := Switch_Chars'First + 1;
 209          Last  : constant Natural  := Switch_Last (Switch_Chars);
 210
 211       begin
 212          --  Skip -o or internal GCC switches together with their argument
 213
 214          if Switch_Chars (First .. Last) = "o"
 215            or else Is_Internal_GCC_Switch (Switch_Chars)
 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          --  Store any other GCC switches. Also do special processing for some
 225          --  specific switches that the Ada front-end knows about.
 226
 227          else
 228             Store_Compilation_Switch (Switch_Chars);
 229
 230             --  Back end switch -fno-inline also sets the Suppress_All_Inlining
 231             --  front end flag to entirely inhibit all inlining.
 232
 233             if Switch_Chars (First .. Last) = "fno-inline" then
 234                Opt.Suppress_All_Inlining := True;
 235
 236             --  Back end switch -fpreserve-control-flow also sets the front end
 237             --  flag that inhibits improper control flow transformations.
 238
 239             elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then
 240                Opt.Suppress_Control_Flow_Optimizations := True;
 241
 242             --  Back end switch -fdump-scos, which exists primarily for C, is
 243             --  also accepted for Ada as a synonym of -gnateS.
 244
 245             elsif Switch_Chars (First .. Last) = "fdump-scos" then
 246                Opt.Generate_SCO := True;
 247
 248             --  Back end switch -fdebug-instances also enables instance table
 249             --  SCO generation.
 250
 251             elsif Switch_Chars (First .. Last) = "fdebug-instances" then
 252                Opt.Generate_SCO_Instance_Table := True;
 253
 254             end if;
 255          end if;
 256       end Scan_Back_End_Switches;
 257
 258       --  Local variables
 259
 260       Arg_Count : constant Natural := Natural (save_argc - 1);
 261       Args : Argument_List (1 .. Arg_Count);
 262
 263    --  Start of processing for Scan_Compiler_Arguments
 264
 265    begin
 266       --  Acquire stack checking mode directly from GCC
 267
 268       Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
 269
 270       --  Put the arguments in Args
 271
 272       for Arg in Pos range 1 .. save_argc - 1 loop
 273          declare
 274             Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
 275             Argv_Len : constant Nat            := Len_Arg (Arg);
 276             Argv     : constant String         :=
 277               Argv_Ptr (1 .. Natural (Argv_Len));
 278          begin
 279             Args (Positive (Arg)) := new String'(Argv);
 280          end;
 281       end loop;
 282
 283       --  Loop through command line arguments, storing them for later access
 284
 285       Next_Arg := 1;
 286       while Next_Arg <= Args'Last loop
 287          Look_At_Arg : declare
 288             Argv     : constant String := Args (Next_Arg).all;
 289
 290          begin
 291             --  If the previous switch has set the Output_File_Name_Present
 292             --  flag (that is we have seen a -gnatO), then the next argument
 293             --  is the name of the output object file.
 294
 295             if Output_File_Name_Present
 296               and then not Output_File_Name_Seen
 297             then
 298                if Is_Switch (Argv) then
 299                   Fail ("Object file name missing after -gnatO");
 300
 301                else
 302                   Set_Output_Object_File_Name (Argv);
 303                   Output_File_Name_Seen := True;
 304                end if;
 305
 306             --  If the previous switch has set the Search_Directory_Present
 307             --  flag (that is if we have just seen -I), then the next argument
 308             --  is a search directory path.
 309
 310             elsif Search_Directory_Present then
 311                if Is_Switch (Argv) then
 312                   Fail ("search directory missing after -I");
 313                else
 314                   Add_Src_Search_Dir (Argv);
 315                   Search_Directory_Present := False;
 316                end if;
 317
 318             elsif not Is_Switch (Argv) then -- must be a file name
 319                Add_File (Argv);
 320
 321             --  We must recognize -nostdinc to suppress visibility on the
 322             --  standard GNAT RTL sources. This is also a gcc switch.
 323
 324             elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
 325                Opt.No_Stdinc := True;
 326                Scan_Back_End_Switches (Argv);
 327
 328             --  We must recognize -nostdlib to suppress visibility on the
 329             --  standard GNAT RTL objects.
 330
 331             elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
 332                Opt.No_Stdlib := True;
 333
 334             elsif Is_Front_End_Switch (Argv) then
 335                Scan_Front_End_Switches (Argv, Args, Next_Arg);
 336
 337             --  All non-front-end switches are back-end switches
 338
 339             else
 340                Scan_Back_End_Switches (Argv);
 341             end if;
 342          end Look_At_Arg;
 343
 344          Next_Arg := Next_Arg + 1;
 345       end loop;
 346    end Scan_Compiler_Arguments;
 347
 348    -----------------------------
 349    -- Register_Back_End_Types --
 350    -----------------------------
 351
 352    procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is
 353       procedure Enumerate_Modes (Call_Back : Register_Type_Proc);
 354       pragma Import (C, Enumerate_Modes, "enumerate_modes");
 355
 356    begin
 357       Enumerate_Modes (Call_Back);
 358    end Register_Back_End_Types;
 359
 360    -------------------------------
 361    -- Gen_Or_Update_Object_File --
 362    -------------------------------
 363
 364    procedure Gen_Or_Update_Object_File is
 365    begin
 366       null;
 367    end Gen_Or_Update_Object_File;
 368
 369 end Back_End;