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