|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- B A C K _ E N D --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
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 Debug; use Debug;
|
|
|
30 with Elists; use Elists;
|
|
|
31 with Errout; use Errout;
|
|
|
32 with Lib; use Lib;
|
|
|
33 with Osint; use Osint;
|
|
|
34 with Opt; use Opt;
|
|
|
35 with Osint.C; use Osint.C;
|
|
|
36 with Namet; use Namet;
|
|
|
37 with Nlists; use Nlists;
|
|
|
38 with Stand; use Stand;
|
|
|
39 with Sinput; use Sinput;
|
|
|
40 with Stringt; use Stringt;
|
|
|
41 with Switch; use Switch;
|
|
|
42 with Switch.C; use Switch.C;
|
|
|
43 with System; use System;
|
|
|
44 with Types; use Types;
|
|
|
45
|
|
|
46 with System.OS_Lib; use System.OS_Lib;
|
|
|
47
|
|
|
48 package 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
|
|
131
|
213 Arg_Count : constant Natural := Natural (save_argc - 1);
|
|
|
214 Args : Argument_List (1 .. Arg_Count);
|
|
|
215
|
|
111
|
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
|
|
145
|
240 -- Skip -o or internal GCC switches together with their argument
|
|
111
|
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
|
|
145
|
247 -- Store -G xxx as -Gxxx and go directly to the next argument
|
|
131
|
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,
|
|
145
|
253 -- but use defensive code nonetheless. Store as -Gxxx to avoid
|
|
|
254 -- storing parameters in ALI files that might create confusion.
|
|
131
|
255
|
|
|
256 if Next_Arg <= Args'Last then
|
|
|
257 Store_Compilation_Switch (Switch_Chars & Args (Next_Arg).all);
|
|
|
258 end if;
|
|
|
259
|
|
111
|
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
|
|
131
|
388 elsif Argv (Argv'First + 1 .. Argv'Last) = "fopenacc" then
|
|
|
389 Opt.OpenAcc_Enabled := True;
|
|
|
390
|
|
111
|
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
|
|
|
402 end Back_End;
|
