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