]>
Commit | Line | Data |
---|---|---|
70482933 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- B A C K _ E N D -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
17ce1f52 | 9 | -- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- |
70482933 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
70482933 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
70482933 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
70482933 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
17ce1f52 AC |
26 | -- This is the version of the Back_End package for GCC back ends |
27 | ||
59f4d038 RD |
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; | |
70482933 | 45 | |
67e740fa VC |
46 | with System.OS_Lib; use System.OS_Lib; |
47 | ||
70482933 RK |
48 | package body Back_End is |
49 | ||
3f165ff2 AC |
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 | ||
3f165ff2 AC |
54 | flag_stack_check : Int; |
55 | pragma Import (C, flag_stack_check); | |
162c21d9 | 56 | -- Indicates if stack checking is enabled, imported from misc.c |
3f165ff2 AC |
57 | |
58 | save_argc : Nat; | |
59 | pragma Import (C, save_argc); | |
547c5954 | 60 | -- Saved value of argc (number of arguments), imported from misc.c |
3f165ff2 AC |
61 | |
62 | save_argv : Arg_Array_Ptr; | |
63 | pragma Import (C, save_argv); | |
547c5954 | 64 | -- Saved value of argv (argument pointers), imported from misc.c |
3f165ff2 AC |
65 | |
66 | function Len_Arg (Arg : Pos) return Nat; | |
67 | -- Determine length of argument number Arg on original gnat1 command line | |
68 | ||
70482933 RK |
69 | ------------------- |
70 | -- Call_Back_End -- | |
71 | ------------------- | |
72 | ||
73 | procedure Call_Back_End (Mode : Back_End_Mode_Type) is | |
74 | ||
c3048783 EB |
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. | |
70482933 | 78 | |
c3048783 | 79 | type File_Info_Type is record |
70482933 | 80 | File_Name : File_Name_Type; |
cf427f02 | 81 | Instance : Instance_Id; |
70482933 RK |
82 | Num_Source_Lines : Nat; |
83 | end record; | |
84 | ||
c3048783 | 85 | File_Info_Array : array (1 .. Last_Source_File) of File_Info_Type; |
70482933 | 86 | |
f53f9dd7 RD |
87 | procedure gigi |
88 | (gnat_root : Int; | |
70482933 RK |
89 | max_gnat_node : Int; |
90 | number_name : Nat; | |
91 | nodes_ptr : Address; | |
4bcf6815 | 92 | flags_ptr : Address; |
70482933 RK |
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; | |
c3048783 | 102 | number_file : Nat; |
70482933 RK |
103 | |
104 | file_info_ptr : Address; | |
01ddebf2 | 105 | gigi_standard_boolean : Entity_Id; |
70482933 | 106 | gigi_standard_integer : Entity_Id; |
6936c61a | 107 | gigi_standard_character : Entity_Id; |
70482933 RK |
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 | ||
70482933 RK |
114 | begin |
115 | -- Skip call if in -gnatdH mode | |
116 | ||
117 | if Debug_Flag_HH then | |
118 | return; | |
119 | end if; | |
120 | ||
b7562769 EB |
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 | ||
f53f9dd7 RD |
124 | for J in 1 .. Last_Source_File loop |
125 | File_Info_Array (J).File_Name := Full_Debug_Name (J); | |
cf427f02 | 126 | File_Info_Array (J).Instance := Instance (J); |
b7562769 EB |
127 | File_Info_Array (J).Num_Source_Lines := |
128 | Nat (Physical_To_Logical (Last_Source_Line (J), J)); | |
70482933 RK |
129 | end loop; |
130 | ||
6c56d9b8 AC |
131 | -- Deal with case of generating SCIL, we should not be here unless |
132 | -- debugging CodePeer mode in GNAT. | |
59f4d038 | 133 | |
1c218ac3 AC |
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 | |
96d2756f | 139 | and then not Back_Annotate_Rep_Info) |
1c218ac3 AC |
140 | then |
141 | return; | |
142 | end if; | |
143 | end if; | |
144 | ||
6c56d9b8 AC |
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 | ||
59f4d038 RD |
153 | -- The actual call to the back end |
154 | ||
f53f9dd7 RD |
155 | gigi |
156 | (gnat_root => Int (Cunit (Main_Unit)), | |
70482933 RK |
157 | max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1), |
158 | number_name => Name_Entries_Count, | |
159 | nodes_ptr => Nodes_Address, | |
4bcf6815 | 160 | flags_ptr => Flags_Address, |
70482933 RK |
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, | |
c3048783 | 170 | number_file => Num_Source_Files, |
70482933 RK |
171 | |
172 | file_info_ptr => File_Info_Array'Address, | |
01ddebf2 | 173 | gigi_standard_boolean => Standard_Boolean, |
70482933 | 174 | gigi_standard_integer => Standard_Integer, |
6936c61a | 175 | gigi_standard_character => Standard_Character, |
70482933 RK |
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 | ||
28bc3323 AC |
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 | ||
3f165ff2 AC |
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 | ||
70482933 RK |
205 | ----------------------------- |
206 | -- Scan_Compiler_Arguments -- | |
207 | ----------------------------- | |
208 | ||
209 | procedure Scan_Compiler_Arguments is | |
67e740fa | 210 | Next_Arg : Positive; |
b26be063 AC |
211 | -- Next argument to be scanned |
212 | ||
70482933 | 213 | Output_File_Name_Seen : Boolean := False; |
f53f9dd7 | 214 | -- Set to True after having scanned file_name for switch "-gnatO file" |
70482933 | 215 | |
70482933 RK |
216 | procedure Scan_Back_End_Switches (Switch_Chars : String); |
217 | -- Procedure to scan out switches stored in Switch_Chars. The first | |
218 | -- character is known to be a valid switch character, and there are no | |
219 | -- blanks or other switch terminator characters in the string, so the | |
220 | -- entire string should consist of valid switch characters, except that | |
221 | -- an optional terminating NUL character is allowed. | |
222 | -- | |
6e00e546 OH |
223 | -- Back end switches have already been checked and processed by GCC in |
224 | -- toplev.c, so no errors can occur and control will always return. The | |
225 | -- switches must still be scanned to skip "-o" or internal GCC switches | |
226 | -- with their argument. | |
70482933 | 227 | |
70482933 RK |
228 | ---------------------------- |
229 | -- Scan_Back_End_Switches -- | |
230 | ---------------------------- | |
231 | ||
232 | procedure Scan_Back_End_Switches (Switch_Chars : String) is | |
233 | First : constant Positive := Switch_Chars'First + 1; | |
6e00e546 | 234 | Last : constant Natural := Switch_Last (Switch_Chars); |
70482933 RK |
235 | |
236 | begin | |
bfe25016 | 237 | -- Skip -o, -G or internal GCC switches together with their argument. |
70482933 | 238 | |
6e00e546 | 239 | if Switch_Chars (First .. Last) = "o" |
bfe25016 | 240 | or else Switch_Chars (First .. Last) = "G" |
6e00e546 | 241 | or else Is_Internal_GCC_Switch (Switch_Chars) |
70482933 RK |
242 | then |
243 | Next_Arg := Next_Arg + 1; | |
244 | ||
07fc65c4 GB |
245 | -- Do not record -quiet switch |
246 | ||
70482933 | 247 | elsif Switch_Chars (First .. Last) = "quiet" then |
07fc65c4 | 248 | null; |
70482933 | 249 | |
70f4ad20 AC |
250 | -- Store any other GCC switches. Also do special processing for some |
251 | -- specific switches that the Ada front-end knows about. | |
07fc65c4 | 252 | |
f53f9dd7 | 253 | else |
70482933 | 254 | Store_Compilation_Switch (Switch_Chars); |
31897c04 | 255 | |
17ce1f52 AC |
256 | -- For gcc back ends, -fno-inline disables Inline pragmas only, |
257 | -- not Inline_Always to remain consistent with the always_inline | |
258 | -- attribute behavior. | |
31897c04 RD |
259 | |
260 | if Switch_Chars (First .. Last) = "fno-inline" then | |
17ce1f52 | 261 | Opt.Disable_FE_Inline := True; |
9549767b | 262 | |
70f4ad20 AC |
263 | -- Back end switch -fpreserve-control-flow also sets the front end |
264 | -- flag that inhibits improper control flow transformations. | |
9549767b AC |
265 | |
266 | elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then | |
267 | Opt.Suppress_Control_Flow_Optimizations := True; | |
70f4ad20 | 268 | |
70805b88 | 269 | -- Back end switch -fdump-scos, which exists primarily for C, is |
70f4ad20 AC |
270 | -- also accepted for Ada as a synonym of -gnateS. |
271 | ||
272 | elsif Switch_Chars (First .. Last) = "fdump-scos" then | |
273 | Opt.Generate_SCO := True; | |
cf427f02 | 274 | Opt.Generate_SCO_Instance_Table := True; |
31897c04 | 275 | end if; |
70482933 RK |
276 | end if; |
277 | end Scan_Back_End_Switches; | |
278 | ||
67e740fa VC |
279 | -- Local variables |
280 | ||
281 | Arg_Count : constant Natural := Natural (save_argc - 1); | |
579847c2 | 282 | Args : Argument_List (1 .. Arg_Count); |
67e740fa | 283 | |
70482933 RK |
284 | -- Start of processing for Scan_Compiler_Arguments |
285 | ||
286 | begin | |
f27ad2b2 RD |
287 | -- Acquire stack checking mode directly from GCC. The reason we do this |
288 | -- is to make sure that the indication of stack checking being enabled | |
289 | -- is the same in the front end and the back end. This status obtained | |
290 | -- from gcc is affected by more than just the switch -fstack-check. | |
70482933 RK |
291 | |
292 | Opt.Stack_Checking_Enabled := (flag_stack_check /= 0); | |
293 | ||
67e740fa VC |
294 | -- Put the arguments in Args |
295 | ||
296 | for Arg in Pos range 1 .. save_argc - 1 loop | |
297 | declare | |
298 | Argv_Ptr : constant Big_String_Ptr := save_argv (Arg); | |
299 | Argv_Len : constant Nat := Len_Arg (Arg); | |
300 | Argv : constant String := | |
579847c2 | 301 | Argv_Ptr (1 .. Natural (Argv_Len)); |
67e740fa VC |
302 | begin |
303 | Args (Positive (Arg)) := new String'(Argv); | |
304 | end; | |
305 | end loop; | |
306 | ||
70482933 RK |
307 | -- Loop through command line arguments, storing them for later access |
308 | ||
b26be063 | 309 | Next_Arg := 1; |
cfab0c49 | 310 | while Next_Arg <= Args'Last loop |
70482933 | 311 | Look_At_Arg : declare |
0355e3eb | 312 | Argv : constant String := Args (Next_Arg).all; |
70482933 RK |
313 | |
314 | begin | |
315 | -- If the previous switch has set the Output_File_Name_Present | |
316 | -- flag (that is we have seen a -gnatO), then the next argument | |
317 | -- is the name of the output object file. | |
318 | ||
579847c2 | 319 | if Output_File_Name_Present and then not Output_File_Name_Seen then |
70482933 RK |
320 | if Is_Switch (Argv) then |
321 | Fail ("Object file name missing after -gnatO"); | |
70482933 RK |
322 | else |
323 | Set_Output_Object_File_Name (Argv); | |
324 | Output_File_Name_Seen := True; | |
325 | end if; | |
65aa56ec | 326 | |
f53f9dd7 RD |
327 | -- If the previous switch has set the Search_Directory_Present |
328 | -- flag (that is if we have just seen -I), then the next argument | |
329 | -- is a search directory path. | |
65aa56ec VC |
330 | |
331 | elsif Search_Directory_Present then | |
332 | if Is_Switch (Argv) then | |
333 | Fail ("search directory missing after -I"); | |
334 | else | |
335 | Add_Src_Search_Dir (Argv); | |
336 | Search_Directory_Present := False; | |
337 | end if; | |
70482933 | 338 | |
579847c2 AC |
339 | -- If not a switch, must be a file name |
340 | ||
341 | elsif not Is_Switch (Argv) then | |
70482933 RK |
342 | Add_File (Argv); |
343 | ||
07fc65c4 GB |
344 | -- We must recognize -nostdinc to suppress visibility on the |
345 | -- standard GNAT RTL sources. This is also a gcc switch. | |
70482933 | 346 | |
07fc65c4 GB |
347 | elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then |
348 | Opt.No_Stdinc := True; | |
349 | Scan_Back_End_Switches (Argv); | |
70482933 | 350 | |
efdfd311 AC |
351 | -- We must recognize -nostdlib to suppress visibility on the |
352 | -- standard GNAT RTL objects. | |
353 | ||
354 | elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then | |
355 | Opt.No_Stdlib := True; | |
356 | ||
07fc65c4 | 357 | elsif Is_Front_End_Switch (Argv) then |
67e740fa | 358 | Scan_Front_End_Switches (Argv, Args, Next_Arg); |
70482933 RK |
359 | |
360 | -- All non-front-end switches are back-end switches | |
361 | ||
362 | else | |
363 | Scan_Back_End_Switches (Argv); | |
364 | end if; | |
365 | end Look_At_Arg; | |
366 | ||
367 | Next_Arg := Next_Arg + 1; | |
368 | end loop; | |
369 | end Scan_Compiler_Arguments; | |
f8726f2b | 370 | |
70482933 | 371 | end Back_End; |