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 26with Atree; use Atree; 27with Debug; use Debug; 28with Elists; use Elists; 29with Errout; use Errout; 30with Lib; use Lib; 31with Osint; use Osint; 32with Opt; use Opt; 33with Osint.C; use Osint.C; 34with Namet; use Namet; 35with Nlists; use Nlists; 36with Stand; use Stand; 37with Sinput; use Sinput; 38with Stringt; use Stringt; 39with Switch; use Switch; 40with Switch.C; use Switch.C; 41with System; use System; 42with Types; use Types; 43 44with System.OS_Lib; use System.OS_Lib; 45 46package 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, -G or internal GCC switches together with their argument. 213 214 if Switch_Chars (First .. Last) = "o" 215 or else Switch_Chars (First .. Last) = "G" 216 or else Is_Internal_GCC_Switch (Switch_Chars) 217 then 218 Next_Arg := Next_Arg + 1; 219 220 -- Do not record -quiet switch 221 222 elsif Switch_Chars (First .. Last) = "quiet" then 223 null; 224 225 -- Store any other GCC switches. Also do special processing for some 226 -- specific switches that the Ada front-end knows about. 227 228 else 229 Store_Compilation_Switch (Switch_Chars); 230 231 -- Back end switch -fno-inline also sets the Suppress_All_Inlining 232 -- front end flag to entirely inhibit all inlining. 233 234 if Switch_Chars (First .. Last) = "fno-inline" then 235 Opt.Suppress_All_Inlining := True; 236 237 -- Back end switch -fpreserve-control-flow also sets the front end 238 -- flag that inhibits improper control flow transformations. 239 240 elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then 241 Opt.Suppress_Control_Flow_Optimizations := True; 242 243 -- Back end switch -fdump-scos, which exists primarily for C, is 244 -- also accepted for Ada as a synonym of -gnateS. 245 246 elsif Switch_Chars (First .. Last) = "fdump-scos" then 247 Opt.Generate_SCO := True; 248 Opt.Generate_SCO_Instance_Table := True; 249 250 end if; 251 end if; 252 end Scan_Back_End_Switches; 253 254 -- Local variables 255 256 Arg_Count : constant Natural := Natural (save_argc - 1); 257 Args : Argument_List (1 .. Arg_Count); 258 259 -- Start of processing for Scan_Compiler_Arguments 260 261 begin 262 -- Acquire stack checking mode directly from GCC 263 264 Opt.Stack_Checking_Enabled := (flag_stack_check /= 0); 265 266 -- Put the arguments in Args 267 268 for Arg in Pos range 1 .. save_argc - 1 loop 269 declare 270 Argv_Ptr : constant Big_String_Ptr := save_argv (Arg); 271 Argv_Len : constant Nat := Len_Arg (Arg); 272 Argv : constant String := 273 Argv_Ptr (1 .. Natural (Argv_Len)); 274 begin 275 Args (Positive (Arg)) := new String'(Argv); 276 end; 277 end loop; 278 279 -- Loop through command line arguments, storing them for later access 280 281 Next_Arg := 1; 282 while Next_Arg <= Args'Last loop 283 Look_At_Arg : declare 284 Argv : constant String := Args (Next_Arg).all; 285 286 begin 287 -- If the previous switch has set the Output_File_Name_Present 288 -- flag (that is we have seen a -gnatO), then the next argument 289 -- is the name of the output object file. 290 291 if Output_File_Name_Present 292 and then not Output_File_Name_Seen 293 then 294 if Is_Switch (Argv) then 295 Fail ("Object file name missing after -gnatO"); 296 297 else 298 Set_Output_Object_File_Name (Argv); 299 Output_File_Name_Seen := True; 300 end if; 301 302 -- If the previous switch has set the Search_Directory_Present 303 -- flag (that is if we have just seen -I), then the next argument 304 -- is a search directory path. 305 306 elsif Search_Directory_Present then 307 if Is_Switch (Argv) then 308 Fail ("search directory missing after -I"); 309 else 310 Add_Src_Search_Dir (Argv); 311 Search_Directory_Present := False; 312 end if; 313 314 elsif not Is_Switch (Argv) then -- must be a file name 315 Add_File (Argv); 316 317 -- We must recognize -nostdinc to suppress visibility on the 318 -- standard GNAT RTL sources. This is also a gcc switch. 319 320 elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then 321 Opt.No_Stdinc := True; 322 Scan_Back_End_Switches (Argv); 323 324 -- We must recognize -nostdlib to suppress visibility on the 325 -- standard GNAT RTL objects. 326 327 elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then 328 Opt.No_Stdlib := True; 329 330 elsif Is_Front_End_Switch (Argv) then 331 Scan_Front_End_Switches (Argv, Args, Next_Arg); 332 333 -- All non-front-end switches are back-end switches 334 335 else 336 Scan_Back_End_Switches (Argv); 337 end if; 338 end Look_At_Arg; 339 340 Next_Arg := Next_Arg + 1; 341 end loop; 342 end Scan_Compiler_Arguments; 343 344 ----------------------------- 345 -- Register_Back_End_Types -- 346 ----------------------------- 347 348 procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is 349 procedure Enumerate_Modes (Call_Back : Register_Type_Proc); 350 pragma Import (C, Enumerate_Modes, "enumerate_modes"); 351 352 begin 353 Enumerate_Modes (Call_Back); 354 end Register_Back_End_Types; 355 356 ------------------------------- 357 -- Gen_Or_Update_Object_File -- 358 ------------------------------- 359 360 procedure Gen_Or_Update_Object_File is 361 begin 362 null; 363 end Gen_Or_Update_Object_File; 364 365end Back_End; 366