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