]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- G N A T 1 D R V -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
8d0d46f4 | 9 | -- Copyright (C) 1992-2021, Free Software Foundation, Inc. -- |
38cbfe40 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- -- |
38cbfe40 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. -- | |
38cbfe40 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. -- |
38cbfe40 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
104f58db BD |
26 | with Atree; use Atree; |
27 | with Back_End; use Back_End; | |
aca670a0 | 28 | with Checks; |
38cbfe40 | 29 | with Comperr; |
851e9f19 | 30 | with Csets; |
104f58db | 31 | with Debug; use Debug; |
38cbfe40 | 32 | with Elists; |
104f58db | 33 | with Errout; use Errout; |
9c41193c | 34 | with Exp_CG; |
fbf5a39b | 35 | with Fmap; |
104f58db BD |
36 | with Fname; use Fname; |
37 | with Fname.UF; use Fname.UF; | |
38cbfe40 | 38 | with Frontend; |
104f58db BD |
39 | with Ghost; use Ghost; |
40 | with Gnatvsn; use Gnatvsn; | |
38cbfe40 | 41 | with Inline; |
104f58db BD |
42 | with Lib; use Lib; |
43 | with Lib.Writ; use Lib.Writ; | |
fbf5a39b | 44 | with Lib.Xref; |
104f58db | 45 | with Namet; use Namet; |
38cbfe40 | 46 | with Nlists; |
104f58db BD |
47 | with Opt; use Opt; |
48 | with Osint; use Osint; | |
49 | with Osint.C; use Osint.C; | |
50 | with Output; use Output; | |
892125cd | 51 | with Par_SCO; |
fbf5a39b | 52 | with Prepcomp; |
e194729e | 53 | with Repinfo; |
6c165711 | 54 | with Repinfo.Input; |
fbf5a39b | 55 | with Restrict; |
104f58db | 56 | with Rident; use Rident; |
804f7040 | 57 | with Rtsfind; |
240fe2a4 | 58 | with SCOs; |
38cbfe40 | 59 | with Sem; |
fbf5a39b AC |
60 | with Sem_Ch8; |
61 | with Sem_Ch12; | |
38cbfe40 | 62 | with Sem_Ch13; |
9596236a | 63 | with Sem_Elim; |
fbf5a39b | 64 | with Sem_Eval; |
f56e04e8 | 65 | with Sem_Prag; |
fbf5a39b | 66 | with Sem_Type; |
289a994b | 67 | with Set_Targ; |
104f58db BD |
68 | with Sinfo; use Sinfo; |
69 | with Sinfo.Nodes; use Sinfo.Nodes; | |
70 | with Sinfo.Utils; use Sinfo.Utils; | |
71 | with Sinput; use Sinput; | |
72 | with Sinput.L; use Sinput.L; | |
73 | with Snames; use Snames; | |
74 | with Sprint; use Sprint; | |
38cbfe40 | 75 | with Stringt; |
104f58db BD |
76 | with Stylesw; use Stylesw; |
77 | with Targparm; use Targparm; | |
5af638c8 | 78 | with Tbuild; |
104f58db | 79 | with Treepr; use Treepr; |
38cbfe40 | 80 | with Ttypes; |
104f58db | 81 | with Types; use Types; |
851e9f19 | 82 | with Uintp; |
104f58db | 83 | with Uname; use Uname; |
38cbfe40 RK |
84 | with Urealp; |
85 | with Usage; | |
104f58db BD |
86 | with Validsw; use Validsw; |
87 | with Warnsw; use Warnsw; | |
38cbfe40 RK |
88 | |
89 | with System.Assertions; | |
cc6f5d75 | 90 | with System.OS_Lib; |
38cbfe40 | 91 | |
28bc3323 AC |
92 | -------------- |
93 | -- Gnat1drv -- | |
94 | -------------- | |
95 | ||
38cbfe40 | 96 | procedure Gnat1drv is |
14e33999 | 97 | procedure Adjust_Global_Switches; |
2cc2e964 | 98 | -- There are various interactions between front-end switch settings, |
14e33999 AC |
99 | -- including debug switch settings and target dependent parameters. |
100 | -- This procedure takes care of properly handling these interactions. | |
84157c9a | 101 | -- We do it after scanning out all the switches, so that we are not |
14e33999 AC |
102 | -- depending on the order in which switches appear. |
103 | ||
d030f3a4 AC |
104 | procedure Check_Bad_Body (Unit_Node : Node_Id; Unit_Kind : Node_Kind); |
105 | -- Called to check whether a unit described by its compilation unit node | |
106 | -- and kind has a bad body. | |
804f7040 VC |
107 | |
108 | procedure Check_Rep_Info; | |
109 | -- Called when we are not generating code, to check if -gnatR was requested | |
110 | -- and if so, explain that we will not be honoring the request. | |
111 | ||
aca670a0 AC |
112 | procedure Post_Compilation_Validation_Checks; |
113 | -- This procedure performs various validation checks that have to be left | |
114 | -- to the end of the compilation process, after generating code but before | |
115 | -- issuing error messages. In particular, these checks generally require | |
116 | -- the information provided by the back end in back annotation of declared | |
117 | -- entities (e.g. actual size and alignment values chosen by the back end). | |
118 | ||
6c165711 EB |
119 | procedure Read_JSON_Files_For_Repinfo; |
120 | -- This procedure exercises the JSON parser of Repinfo by reading back the | |
121 | -- JSON files generated by -gnatRjs in a previous compilation session. It | |
122 | -- is intended to make sure that the JSON generator and the JSON parser are | |
123 | -- kept synchronized when the JSON format evolves. | |
124 | ||
14e33999 AC |
125 | ---------------------------- |
126 | -- Adjust_Global_Switches -- | |
127 | ---------------------------- | |
128 | ||
129 | procedure Adjust_Global_Switches is | |
ef952fd5 HK |
130 | procedure SPARK_Library_Warning (Kind : String); |
131 | -- Issue a warning in GNATprove mode if the run-time library does not | |
132 | -- fully support IEEE-754 floating-point semantics. | |
133 | ||
134 | --------------------------- | |
135 | -- SPARK_Library_Warning -- | |
136 | --------------------------- | |
137 | ||
138 | procedure SPARK_Library_Warning (Kind : String) is | |
139 | begin | |
140 | Write_Line | |
141 | ("warning: run-time library may be configured incorrectly"); | |
142 | Write_Line | |
143 | ("warning: (SPARK analysis requires support for " & Kind & ')'); | |
144 | end SPARK_Library_Warning; | |
145 | ||
146 | -- Start of processing for Adjust_Global_Switches | |
147 | ||
14e33999 | 148 | begin |
967947ed PMR |
149 | -- Define pragma GNAT_Annotate as an alias of pragma Annotate, to be |
150 | -- able to work around bootstrap limitations with the old syntax of | |
151 | -- pragma Annotate, and use pragma GNAT_Annotate in compiler sources | |
16d92641 PMR |
152 | -- when needed. |
153 | ||
154 | Map_Pragma_Name (From => Name_Gnat_Annotate, To => Name_Annotate); | |
155 | ||
303fbb20 | 156 | -- -gnatd.M enables Relaxed_RM_Semantics |
76efd572 | 157 | |
303fbb20 AC |
158 | if Debug_Flag_Dot_MM then |
159 | Relaxed_RM_Semantics := True; | |
76efd572 | 160 | end if; |
5a271a7f RD |
161 | |
162 | -- -gnatd.1 enables unnesting of subprograms | |
163 | ||
164 | if Debug_Flag_Dot_1 then | |
165 | Unnest_Subprogram_Mode := True; | |
166 | end if; | |
14e33999 | 167 | |
45969c97 | 168 | -- -gnatd.u enables special C expansion mode |
a0367a97 | 169 | |
45969c97 | 170 | if Debug_Flag_Dot_U then |
a0367a97 | 171 | Modify_Tree_For_C := True; |
b36ec518 | 172 | Transform_Function_Array := True; |
a0367a97 AC |
173 | end if; |
174 | ||
dd81163f | 175 | -- -gnatd_A disables generation of ALI files |
1ac984f5 AC |
176 | |
177 | if Debug_Flag_Underscore_AA then | |
178 | Disable_ALI_File := True; | |
179 | end if; | |
180 | ||
95bcd2a7 AC |
181 | -- Set all flags required when generating C code |
182 | ||
183 | if Generate_C_Code then | |
45969c97 | 184 | Modify_Tree_For_C := True; |
b36ec518 | 185 | Transform_Function_Array := True; |
ed05b790 | 186 | Unnest_Subprogram_Mode := True; |
78cac738 | 187 | Building_Static_Dispatch_Tables := False; |
f916243b | 188 | Minimize_Expression_With_Actions := True; |
f4ac86dd | 189 | Expand_Nonbinary_Modular_Ops := True; |
45969c97 | 190 | |
45969c97 AC |
191 | -- Set operating mode to Generate_Code to benefit from full front-end |
192 | -- expansion (e.g. generics). | |
193 | ||
194 | Operating_Mode := Generate_Code; | |
549cc9c2 AC |
195 | |
196 | -- Suppress alignment checks since we do not have access to alignment | |
df9ad6bc | 197 | -- info on the target. |
549cc9c2 AC |
198 | |
199 | Suppress_Options.Suppress (Alignment_Check) := False; | |
ed05b790 RD |
200 | end if; |
201 | ||
0247964d AC |
202 | -- -gnatd.E sets Error_To_Warning mode, causing selected error messages |
203 | -- to be treated as warnings instead of errors. | |
204 | ||
205 | if Debug_Flag_Dot_EE then | |
206 | Error_To_Warning := True; | |
207 | end if; | |
208 | ||
f63adaa7 AC |
209 | -- -gnatdJ sets Include_Subprogram_In_Messages, adding the related |
210 | -- subprogram as part of the error and warning messages. | |
211 | ||
212 | if Debug_Flag_JJ then | |
213 | Include_Subprogram_In_Messages := True; | |
214 | end if; | |
215 | ||
76e3504f AC |
216 | -- Disable CodePeer_Mode in Check_Syntax, since we need front-end |
217 | -- expansion. | |
218 | ||
219 | if Operating_Mode = Check_Syntax then | |
220 | CodePeer_Mode := False; | |
221 | end if; | |
222 | ||
76efd572 AC |
223 | -- SCIL mode needs to disable front-end inlining since the generated |
224 | -- trees (in particular order and consistency between specs compiled | |
225 | -- as part of a main unit or as part of a with-clause) are causing | |
226 | -- troubles. | |
14e33999 | 227 | |
76efd572 AC |
228 | if Generate_SCIL then |
229 | Front_End_Inlining := False; | |
14e33999 AC |
230 | end if; |
231 | ||
0d901290 | 232 | -- Tune settings for optimal SCIL generation in CodePeer mode |
76efd572 AC |
233 | |
234 | if CodePeer_Mode then | |
235 | ||
72eaa365 AC |
236 | -- Turn off gnatprove mode (which can be set via e.g. -gnatd.F), not |
237 | -- compatible with CodePeer mode. | |
a921e83c AC |
238 | |
239 | GNATprove_Mode := False; | |
72eaa365 | 240 | Debug_Flag_Dot_FF := False; |
a921e83c | 241 | |
87843c83 DM |
242 | -- Turn off length expansion. CodePeer has its own mechanism to |
243 | -- handle length attribute. | |
162ea0d3 | 244 | |
87843c83 DM |
245 | Debug_Flag_Dot_PP := True; |
246 | ||
213999c2 AC |
247 | -- Turn off C tree generation, not compatible with CodePeer mode. We |
248 | -- do not expect this to happen in normal use, since both modes are | |
249 | -- enabled by special tools, but it is useful to turn off these flags | |
e8c84c8f | 250 | -- this way when we are doing CodePeer tests on existing test suites |
aff557c7 | 251 | -- that may have -gnateg set, to avoid the need for special casing. |
213999c2 | 252 | |
b36ec518 AC |
253 | Modify_Tree_For_C := False; |
254 | Transform_Function_Array := False; | |
255 | Generate_C_Code := False; | |
256 | Unnest_Subprogram_Mode := False; | |
213999c2 | 257 | |
a712aa03 | 258 | -- Turn off inlining, confuses CodePeer output and gains nothing |
14e33999 | 259 | |
14e33999 | 260 | Front_End_Inlining := False; |
76efd572 AC |
261 | Inline_Active := False; |
262 | ||
b7d5e87b AC |
263 | -- Disable front-end optimizations, to keep the tree as close to the |
264 | -- source code as possible, and also to avoid inconsistencies between | |
265 | -- trees when using different optimization switches. | |
266 | ||
267 | Optimization_Level := 0; | |
268 | ||
87dc09cb AC |
269 | -- Enable some restrictions systematically to simplify the generated |
270 | -- code (and ease analysis). Note that restriction checks are also | |
2551782d AC |
271 | -- disabled in CodePeer mode, see Restrict.Check_Restriction, and |
272 | -- user specified Restrictions pragmas are ignored, see | |
273 | -- Sem_Prag.Process_Restrictions_Or_Restriction_Warnings. | |
47bfea3a | 274 | |
45969c97 | 275 | Restrict.Restrictions.Set (No_Exception_Registration) := True; |
2551782d | 276 | Restrict.Restrictions.Set (No_Initialize_Scalars) := True; |
0d901290 AC |
277 | Restrict.Restrictions.Set (No_Task_Hierarchy) := True; |
278 | Restrict.Restrictions.Set (No_Abort_Statements) := True; | |
279 | Restrict.Restrictions.Set (Max_Asynchronous_Select_Nesting) := True; | |
87dc09cb | 280 | Restrict.Restrictions.Value (Max_Asynchronous_Select_Nesting) := 0; |
47bfea3a | 281 | |
b7051481 AC |
282 | -- Enable pragma Ignore_Pragma (Global) to support legacy code. As a |
283 | -- consequence, Refined_Global pragma should be ignored as well, as | |
284 | -- it is only allowed on a body when pragma Global is given for the | |
285 | -- spec. | |
83b77c5c | 286 | |
b7051481 AC |
287 | Set_Name_Table_Boolean3 (Name_Global, True); |
288 | Set_Name_Table_Boolean3 (Name_Refined_Global, True); | |
83b77c5c AC |
289 | |
290 | -- Suppress division by zero checks since they are handled | |
97948f41 | 291 | -- implicitly by CodePeer. |
5a1ccfb1 AC |
292 | |
293 | -- Turn off dynamic elaboration checks: generates inconsistencies in | |
76efd572 AC |
294 | -- trees between specs compiled as part of a main unit or as part of |
295 | -- a with-clause. | |
296 | ||
9d0c3761 AC |
297 | -- Turn off alignment checks: these cannot be proved statically by |
298 | -- CodePeer and generate false positives. | |
299 | ||
5a1ccfb1 | 300 | -- Enable all other language checks |
76efd572 | 301 | |
a7f1b24f | 302 | Suppress_Options.Suppress := |
44900051 | 303 | (Alignment_Check => True, |
a7f1b24f RD |
304 | Division_Check => True, |
305 | Elaboration_Check => True, | |
306 | others => False); | |
3217f71e | 307 | |
9ae497cb AC |
308 | -- Need to enable dynamic elaboration checks to disable strict |
309 | -- static checking performed by gnatbind. We are at the same time | |
310 | -- suppressing actual compile time elaboration checks to simplify | |
311 | -- the generated code. | |
312 | ||
313 | Dynamic_Elaboration_Checks := True; | |
76efd572 | 314 | |
ceee0bde AC |
315 | -- Set STRICT mode for overflow checks if not set explicitly. This |
316 | -- prevents suppressing of overflow checks by default, in code down | |
317 | -- below. | |
97948f41 | 318 | |
15c94a55 RD |
319 | if Suppress_Options.Overflow_Mode_General = Not_Set then |
320 | Suppress_Options.Overflow_Mode_General := Strict; | |
321 | Suppress_Options.Overflow_Mode_Assertions := Strict; | |
97948f41 AC |
322 | end if; |
323 | ||
3565684a AC |
324 | -- CodePeer handles division and overflow checks directly, based on |
325 | -- the marks set by the frontend, hence no special expansion should | |
326 | -- be performed in the frontend for division and overflow checks. | |
327 | ||
328 | Backend_Divide_Checks_On_Target := True; | |
329 | Backend_Overflow_Checks_On_Target := True; | |
330 | ||
76efd572 AC |
331 | -- Kill debug of generated code, since it messes up sloc values |
332 | ||
333 | Debug_Generated_Code := False; | |
334 | ||
f4f5851e AC |
335 | -- Ditto for -gnateG which interacts badly with handling of pragma |
336 | -- Annotate in gnat2scil. | |
337 | ||
338 | Generate_Processed_File := False; | |
339 | ||
b0bf18ad AC |
340 | -- Disable Exception_Extra_Info (-gnateE) which generates more |
341 | -- complex trees with no added value, and may confuse CodePeer. | |
342 | ||
343 | Exception_Extra_Info := False; | |
344 | ||
0d901290 | 345 | -- Turn cross-referencing on in case it was disabled (e.g. by -gnatD) |
a5150cb1 | 346 | -- to support source navigation. |
76efd572 AC |
347 | |
348 | Xref_Active := True; | |
349 | ||
0d901290 AC |
350 | -- Set operating mode to Generate_Code to benefit from full front-end |
351 | -- expansion (e.g. generics). | |
76efd572 | 352 | |
46fe0142 | 353 | Operating_Mode := Generate_Code; |
76efd572 AC |
354 | |
355 | -- We need SCIL generation of course | |
356 | ||
357 | Generate_SCIL := True; | |
358 | ||
aab45d22 | 359 | -- Enable assertions, since they give CodePeer valuable extra info |
76efd572 | 360 | |
7b64b700 | 361 | Assertions_Enabled := True; |
76efd572 | 362 | |
a5150cb1 | 363 | -- Set normal RM validity checking and checking of copies (to catch |
d1b83e62 | 364 | -- e.g. wrong values used in unchecked conversions). |
a5150cb1 AC |
365 | -- All other validity checking is turned off, since this can generate |
366 | -- very complex trees that only confuse CodePeer and do not bring | |
367 | -- enough useful info. | |
76efd572 AC |
368 | |
369 | Reset_Validity_Check_Options; | |
7cbe60de | 370 | Set_Validity_Check_Options ("dc"); |
6afd4d64 | 371 | Check_Validity_Of_Parameters := False; |
76efd572 | 372 | |
b04d926e AC |
373 | -- Turn off style check options and ignore any style check pragmas |
374 | -- since we are not interested in any front-end warnings when we are | |
375 | -- getting CodePeer output. | |
76efd572 AC |
376 | |
377 | Reset_Style_Check_Options; | |
b04d926e | 378 | Ignore_Style_Checks_Pragmas := True; |
d606f1df AC |
379 | |
380 | -- Always perform semantics and generate ali files in CodePeer mode, | |
381 | -- so that a gnatmake -c -k will proceed further when possible. | |
382 | ||
ba203461 | 383 | Force_ALI_File := True; |
d606f1df | 384 | Try_Semantics := True; |
303fbb20 | 385 | |
2cc2e964 | 386 | -- Make the Ada front end more liberal so that the compiler will |
5b75bf57 | 387 | -- allow illegal code that is allowed by other compilers. CodePeer |
a90bd866 | 388 | -- is in the business of finding problems, not enforcing rules. |
5b75bf57 AC |
389 | -- This is useful when using CodePeer mode with other compilers. |
390 | ||
303fbb20 | 391 | Relaxed_RM_Semantics := True; |
a5150cb1 | 392 | |
f6d606c7 DM |
393 | if Generate_CodePeer_Messages then |
394 | ||
395 | -- We do want to emit GNAT warnings when using -gnateC. But, | |
396 | -- in CodePeer mode, warnings about memory representation are not | |
397 | -- meaningful, thus, suppress them. | |
398 | ||
399 | Warn_On_Biased_Representation := False; -- -gnatw.b | |
400 | Warn_On_Unrepped_Components := False; -- -gnatw.c | |
401 | Warn_On_Record_Holes := False; -- -gnatw.h | |
402 | Warn_On_Unchecked_Conversion := False; -- -gnatwz | |
403 | Warn_On_Size_Alignment := False; -- -gnatw.z | |
404 | Warn_On_Questionable_Layout := False; -- -gnatw.q | |
405 | Warn_On_Overridden_Size := False; -- -gnatw.s | |
406 | Warn_On_Reverse_Bit_Order := False; -- -gnatw.v | |
407 | ||
408 | else | |
d63199d8 | 409 | |
c23f55b4 | 410 | -- Suppress compiler warnings by default when generating SCIL for |
d63199d8 PMR |
411 | -- CodePeer, except when combined with -gnateC where we do want to |
412 | -- emit GNAT warnings. | |
c23f55b4 PMR |
413 | |
414 | Warning_Mode := Suppress; | |
415 | end if; | |
416 | ||
a5150cb1 AC |
417 | -- Disable all simple value propagation. This is an optimization |
418 | -- which is valuable for code optimization, and also for generation | |
419 | -- of compiler warnings, but these are being turned off by default, | |
420 | -- and CodePeer generates better messages (referencing original | |
421 | -- variables) this way. | |
05f1a543 | 422 | -- Do this only if -gnatws is set (the default with -gnatcC), so that |
a5150cb1 AC |
423 | -- if warnings are enabled, we'll get better messages from GNAT. |
424 | ||
425 | if Warning_Mode = Suppress then | |
426 | Debug_Flag_MM := True; | |
427 | end if; | |
c11207d3 PT |
428 | |
429 | -- The implementation of 'Value that uses a perfect hash function | |
430 | -- is significantly more complex and harder to initialize than the | |
431 | -- old implementation. Deactivate it for CodePeer. | |
432 | ||
433 | Debug_Flag_Underscore_H := True; | |
303fbb20 AC |
434 | end if; |
435 | ||
800da977 AC |
436 | -- Enable some individual switches that are implied by relaxed RM |
437 | -- semantics mode. | |
438 | ||
303fbb20 | 439 | if Relaxed_RM_Semantics then |
818b578d | 440 | Opt.Allow_Integer_Address := True; |
303fbb20 | 441 | Overriding_Renamings := True; |
5ff90f08 | 442 | Treat_Categorization_Errors_As_Warnings := True; |
14e33999 AC |
443 | end if; |
444 | ||
f5da7a97 | 445 | -- Enable GNATprove_Mode when using -gnatd.F switch |
6c2e4047 | 446 | |
8bfbd380 | 447 | if Debug_Flag_Dot_FF then |
f5da7a97 | 448 | GNATprove_Mode := True; |
8bfbd380 AC |
449 | end if; |
450 | ||
f5da7a97 YM |
451 | -- GNATprove_Mode is also activated by default in the gnat2why |
452 | -- executable. | |
8bfbd380 | 453 | |
f5da7a97 | 454 | if GNATprove_Mode then |
ceee0bde | 455 | |
9dd8f36f AC |
456 | -- Turn off CodePeer mode (which can be set via e.g. -gnatC or |
457 | -- -gnateC), not compatible with GNATprove mode. | |
458 | ||
459 | CodePeer_Mode := False; | |
460 | Generate_SCIL := False; | |
461 | ||
462 | -- Turn off C tree generation, not compatible with GNATprove mode. We | |
463 | -- do not expect this to happen in normal use, since both modes are | |
464 | -- enabled by special tools, but it is useful to turn off these flags | |
465 | -- this way when we are doing GNATprove tests on existing test suites | |
466 | -- that may have -gnateg set, to avoid the need for special casing. | |
467 | ||
b36ec518 AC |
468 | Modify_Tree_For_C := False; |
469 | Transform_Function_Array := False; | |
470 | Generate_C_Code := False; | |
471 | Unnest_Subprogram_Mode := False; | |
9dd8f36f | 472 | |
ceee0bde AC |
473 | -- Turn off inlining, which would confuse formal verification output |
474 | -- and gain nothing. | |
475 | ||
476 | Front_End_Inlining := False; | |
477 | Inline_Active := False; | |
478 | ||
43478196 YM |
479 | -- Issue warnings for failure to inline subprograms, as otherwise |
480 | -- expected in GNATprove mode for the local subprograms without | |
481 | -- contracts. | |
482 | ||
483 | Ineffective_Inline_Warnings := True; | |
484 | ||
014eddc6 YM |
485 | -- Do not issue warnings for possible propagation of exception. |
486 | -- GNATprove already issues messages about possible exceptions. | |
487 | ||
488 | No_Warn_On_Non_Local_Exception := True; | |
489 | Warn_On_Non_Local_Exception := False; | |
490 | ||
ceee0bde AC |
491 | -- Disable front-end optimizations, to keep the tree as close to the |
492 | -- source code as possible, and also to avoid inconsistencies between | |
493 | -- trees when using different optimization switches. | |
494 | ||
495 | Optimization_Level := 0; | |
496 | ||
497 | -- Enable some restrictions systematically to simplify the generated | |
6e840989 | 498 | -- code (and ease analysis). |
ceee0bde AC |
499 | |
500 | Restrict.Restrictions.Set (No_Initialize_Scalars) := True; | |
501 | ||
502 | -- Note: at this point we used to suppress various checks, but that | |
503 | -- is not what we want. We need the semantic processing for these | |
504 | -- checks (which will set flags like Do_Overflow_Check, showing the | |
505 | -- points at which potential checks are required semantically). We | |
506 | -- don't want the expansion associated with these checks, but that | |
507 | -- happens anyway because this expansion is simply not done in the | |
06b599fd | 508 | -- SPARK version of the expander. |
ceee0bde | 509 | |
715e529d | 510 | -- On the contrary, we need to enable explicitly all language checks, |
3c756b76 | 511 | -- as they may have been suppressed by the use of switch -gnatp. |
715e529d AC |
512 | |
513 | Suppress_Options.Suppress := (others => False); | |
514 | ||
783da331 AC |
515 | -- Detect overflow on unconstrained floating-point types, such as |
516 | -- the predefined types Float, Long_Float and Long_Long_Float from | |
af6478c8 AC |
517 | -- package Standard. Not necessary if float overflows are checked |
518 | -- (Machine_Overflow true), since appropriate Do_Overflow_Check flags | |
519 | -- will be set in any case. | |
783da331 | 520 | |
af6478c8 | 521 | Check_Float_Overflow := not Machine_Overflows_On_Target; |
783da331 | 522 | |
ceee0bde AC |
523 | -- Set STRICT mode for overflow checks if not set explicitly. This |
524 | -- prevents suppressing of overflow checks by default, in code down | |
525 | -- below. | |
526 | ||
15c94a55 RD |
527 | if Suppress_Options.Overflow_Mode_General = Not_Set then |
528 | Suppress_Options.Overflow_Mode_General := Strict; | |
529 | Suppress_Options.Overflow_Mode_Assertions := Strict; | |
ceee0bde AC |
530 | end if; |
531 | ||
532 | -- Kill debug of generated code, since it messes up sloc values | |
533 | ||
534 | Debug_Generated_Code := False; | |
535 | ||
536 | -- Turn cross-referencing on in case it was disabled (e.g. by -gnatD) | |
537 | -- as it is needed for computing effects of subprograms in the formal | |
538 | -- verification backend. | |
539 | ||
540 | Xref_Active := True; | |
541 | ||
f5da7a97 YM |
542 | -- Set operating mode to Check_Semantics, but a light front-end |
543 | -- expansion is still performed. | |
ceee0bde | 544 | |
f5da7a97 | 545 | Operating_Mode := Check_Semantics; |
ceee0bde | 546 | |
aab45d22 AC |
547 | -- Enable assertions, since they give valuable extra information for |
548 | -- formal verification. | |
ceee0bde | 549 | |
aab45d22 | 550 | Assertions_Enabled := True; |
ceee0bde | 551 | |
b5eccd0c AC |
552 | -- Disable validity checks, since it generates code raising |
553 | -- exceptions for invalid data, which confuses GNATprove. Invalid | |
554 | -- data is directly detected by GNATprove's flow analysis. | |
555 | ||
556 | Validity_Checks_On := False; | |
6afd4d64 | 557 | Check_Validity_Of_Parameters := False; |
b5eccd0c | 558 | |
ceee0bde | 559 | -- Turn off style check options since we are not interested in any |
06b599fd | 560 | -- front-end warnings when we are getting SPARK output. |
ceee0bde AC |
561 | |
562 | Reset_Style_Check_Options; | |
563 | ||
ceee0bde | 564 | -- Suppress the generation of name tables for enumerations, which are |
06b599fd | 565 | -- not needed for formal verification, and fall outside the SPARK |
ceee0bde AC |
566 | -- subset (use of pointers). |
567 | ||
568 | Global_Discard_Names := True; | |
569 | ||
570 | -- Suppress the expansion of tagged types and dispatching calls, | |
06b599fd | 571 | -- which lead to the generation of non-SPARK code (use of pointers), |
ceee0bde AC |
572 | -- which is more complex to formally verify than the original source. |
573 | ||
574 | Tagged_Type_Expansion := False; | |
bfc37f37 | 575 | |
f5a7c656 YM |
576 | -- Force the use of "error:" prefix for error messages |
577 | ||
578 | Unique_Error_Tag := True; | |
579 | ||
bfc37f37 AC |
580 | -- Detect that the runtime library support for floating-point numbers |
581 | -- may not be compatible with SPARK analysis of IEEE-754 floats. | |
582 | ||
ef952fd5 HK |
583 | if Denorm_On_Target = False then |
584 | SPARK_Library_Warning ("float subnormals"); | |
585 | ||
586 | elsif Machine_Rounds_On_Target = False then | |
587 | SPARK_Library_Warning ("float rounding"); | |
588 | ||
589 | elsif Signed_Zeros_On_Target = False then | |
590 | SPARK_Library_Warning ("signed zeros"); | |
591 | end if; | |
ceee0bde AC |
592 | end if; |
593 | ||
7b64b700 RD |
594 | -- Set Configurable_Run_Time mode if system.ads flag set or if the |
595 | -- special debug flag -gnatdY is set. | |
14e33999 AC |
596 | |
597 | if Targparm.Configurable_Run_Time_On_Target or Debug_Flag_YY then | |
598 | Configurable_Run_Time_Mode := True; | |
599 | end if; | |
600 | ||
1c912574 | 601 | -- Set -gnatRm mode if debug flag A set |
14e33999 AC |
602 | |
603 | if Debug_Flag_AA then | |
604 | Back_Annotate_Rep_Info := True; | |
605 | List_Representation_Info := 1; | |
606 | List_Representation_Info_Mechanisms := True; | |
607 | end if; | |
608 | ||
609 | -- Force Target_Strict_Alignment true if debug flag -gnatd.a is set | |
610 | ||
611 | if Debug_Flag_Dot_A then | |
612 | Ttypes.Target_Strict_Alignment := True; | |
613 | end if; | |
614 | ||
f8f50235 AC |
615 | -- Disable static allocation of dispatch tables if -gnatd.t is enabled. |
616 | -- The front end's layout phase currently treats types that have | |
617 | -- discriminant-dependent arrays as not being static even when a | |
14e33999 AC |
618 | -- discriminant constraint on the type is static, and this leads to |
619 | -- problems with subtypes of type Ada.Tags.Dispatch_Table_Wrapper. ??? | |
620 | ||
f8f50235 | 621 | if Debug_Flag_Dot_T then |
6214b83b | 622 | Building_Static_Dispatch_Tables := False; |
14e33999 AC |
623 | end if; |
624 | ||
625 | -- Flip endian mode if -gnatd8 set | |
626 | ||
627 | if Debug_Flag_8 then | |
628 | Ttypes.Bytes_Big_Endian := not Ttypes.Bytes_Big_Endian; | |
629 | end if; | |
630 | ||
0289a8d7 | 631 | -- Set and check exception mechanism. This is only meaningful when |
c4aeb3c3 | 632 | -- generating code. |
0289a8d7 | 633 | |
c4aeb3c3 | 634 | if Operating_Mode = Generate_Code then |
0289a8d7 AC |
635 | case Targparm.Frontend_Exceptions_On_Target is |
636 | when True => | |
637 | case Targparm.ZCX_By_Default_On_Target is | |
638 | when True => | |
639 | Write_Line | |
640 | ("Run-time library configured incorrectly"); | |
641 | Write_Line | |
642 | ("(requesting support for Frontend ZCX exceptions)"); | |
643 | raise Unrecoverable_Error; | |
d8f43ee6 | 644 | |
0289a8d7 AC |
645 | when False => |
646 | Exception_Mechanism := Front_End_SJLJ; | |
647 | end case; | |
d8f43ee6 | 648 | |
0289a8d7 AC |
649 | when False => |
650 | case Targparm.ZCX_By_Default_On_Target is | |
651 | when True => | |
652 | Exception_Mechanism := Back_End_ZCX; | |
653 | when False => | |
654 | Exception_Mechanism := Back_End_SJLJ; | |
655 | end case; | |
656 | end case; | |
657 | end if; | |
14e33999 | 658 | |
a7f1b24f | 659 | -- Set proper status for overflow check mechanism |
95081e99 | 660 | |
06b599fd | 661 | -- If already set (by -gnato or above in SPARK or CodePeer mode) then we |
ceee0bde | 662 | -- have nothing to do. |
05b34c18 | 663 | |
15c94a55 | 664 | if Opt.Suppress_Options.Overflow_Mode_General /= Not_Set then |
05b34c18 AC |
665 | null; |
666 | ||
a7f1b24f | 667 | -- Otherwise set overflow mode defaults |
95081e99 | 668 | |
a7f1b24f | 669 | else |
e9a79435 RD |
670 | -- Overflow checks are on by default (Suppress set False) except in |
671 | -- GNAT_Mode, where we want them off by default (we are not ready to | |
672 | -- enable overflow checks in the compiler yet, for one thing the case | |
673 | -- of 64-bit checks needs System.Arith_64 which is not a compiler | |
674 | -- unit and it is a pain to try to include it in the compiler. | |
2352eadb | 675 | |
e9a79435 | 676 | Suppress_Options.Suppress (Overflow_Check) := GNAT_Mode; |
2352eadb | 677 | |
a7f1b24f RD |
678 | -- Set appropriate default overflow handling mode. Note: at present |
679 | -- we set STRICT in all three of the following cases. They are | |
680 | -- separated because in the future we may make different choices. | |
05b34c18 | 681 | |
a7f1b24f | 682 | -- By default set STRICT mode if -gnatg in effect |
05b34c18 | 683 | |
a7f1b24f | 684 | if GNAT_Mode then |
15c94a55 RD |
685 | Suppress_Options.Overflow_Mode_General := Strict; |
686 | Suppress_Options.Overflow_Mode_Assertions := Strict; | |
05b34c18 | 687 | |
a7f1b24f RD |
688 | -- If we have backend divide and overflow checks, then by default |
689 | -- overflow checks are STRICT. Historically this code used to also | |
690 | -- activate overflow checks, although no target currently has these | |
691 | -- flags set, so this was dead code anyway. | |
692 | ||
693 | elsif Targparm.Backend_Divide_Checks_On_Target | |
e9a79435 RD |
694 | and |
695 | Targparm.Backend_Overflow_Checks_On_Target | |
a7f1b24f | 696 | then |
15c94a55 RD |
697 | Suppress_Options.Overflow_Mode_General := Strict; |
698 | Suppress_Options.Overflow_Mode_Assertions := Strict; | |
a7f1b24f RD |
699 | |
700 | -- Otherwise for now, default is STRICT mode. This may change in the | |
701 | -- future, but for now this is the compatible behavior with previous | |
702 | -- versions of GNAT. | |
703 | ||
704 | else | |
15c94a55 RD |
705 | Suppress_Options.Overflow_Mode_General := Strict; |
706 | Suppress_Options.Overflow_Mode_Assertions := Strict; | |
a7f1b24f | 707 | end if; |
14e33999 | 708 | end if; |
9cbfc269 | 709 | |
6eddd7b4 AC |
710 | -- Set default for atomic synchronization. As this synchronization |
711 | -- between atomic accesses can be expensive, and not typically needed | |
712 | -- on some targets, an optional target parameter can turn the option | |
713 | -- off. Note Atomic Synchronization is implemented as check. | |
714 | ||
3217f71e | 715 | Suppress_Options.Suppress (Atomic_Synchronization) := |
ef7c5fa9 | 716 | not Atomic_Sync_Default_On_Target; |
6eddd7b4 | 717 | |
c944345b RD |
718 | -- Set default for Alignment_Check, if we are on a machine with non- |
719 | -- strict alignment, then we suppress this check, since it is over- | |
720 | -- zealous for such machines. | |
721 | ||
722 | if not Ttypes.Target_Strict_Alignment then | |
723 | Suppress_Options.Suppress (Alignment_Check) := True; | |
724 | end if; | |
725 | ||
305caf42 AC |
726 | -- Set switch indicating if back end can handle limited types, and |
727 | -- guarantee that no incorrect copies are made (e.g. in the context | |
9b16cb57 | 728 | -- of an if or case expression). |
305caf42 AC |
729 | |
730 | -- Debug flag -gnatd.L decisively sets usage on | |
731 | ||
19d846a0 | 732 | if Debug_Flag_Dot_LL then |
305caf42 AC |
733 | Back_End_Handles_Limited_Types := True; |
734 | ||
0da343bc | 735 | -- If no debug flag, usage off for SCIL cases |
305caf42 | 736 | |
0da343bc | 737 | elsif Generate_SCIL then |
305caf42 AC |
738 | Back_End_Handles_Limited_Types := False; |
739 | ||
afb2d209 | 740 | -- Otherwise normal gcc back end, for now still turn flag off by |
9c8ff9b9 | 741 | -- default, since there are unresolved problems in the front end. |
305caf42 AC |
742 | |
743 | else | |
744 | Back_End_Handles_Limited_Types := False; | |
745 | end if; | |
2933b16c | 746 | |
4c7be310 AC |
747 | -- If the inlining level has not been set by the user, compute it from |
748 | -- the optimization level: 1 at -O1/-O2 (and -Os), 2 at -O3 and above. | |
749 | ||
750 | if Inline_Level = 0 then | |
751 | if Optimization_Level < 3 then | |
752 | Inline_Level := 1; | |
753 | else | |
754 | Inline_Level := 2; | |
755 | end if; | |
756 | end if; | |
05b34c18 | 757 | |
c9f95e4c AC |
758 | -- Treat -gnatn as equivalent to -gnatN for non-GCC targets |
759 | ||
4d1429b2 AC |
760 | if Inline_Active and not Front_End_Inlining then |
761 | ||
762 | -- We really should have a tag for this, what if we added a new | |
763 | -- back end some day, it would not be true for this test, but it | |
764 | -- would be non-GCC, so this is a bit troublesome ??? | |
765 | ||
0da343bc | 766 | Front_End_Inlining := Generate_C_Code; |
c9f95e4c AC |
767 | end if; |
768 | ||
2cc2e964 | 769 | -- Set back-end inlining indication |
f087ea44 AC |
770 | |
771 | Back_End_Inlining := | |
c5670cb4 | 772 | |
2cc2e964 | 773 | -- No back-end inlining available on C generation |
2700b9c1 | 774 | |
0da343bc | 775 | not Generate_C_Code |
2700b9c1 | 776 | |
2cc2e964 | 777 | -- No back-end inlining in GNATprove mode, since it just confuses |
c5670cb4 RD |
778 | -- the formal verification process. |
779 | ||
780 | and then not GNATprove_Mode | |
781 | ||
2cc2e964 | 782 | -- No back-end inlining if front-end inlining explicitly enabled. |
0f345950 JM |
783 | -- Done to minimize the output differences to customers still using |
784 | -- this deprecated switch; in addition, this behavior reduces the | |
785 | -- output differences in old tests. | |
c5670cb4 RD |
786 | |
787 | and then not Front_End_Inlining | |
788 | ||
2cc2e964 | 789 | -- Back-end inlining is disabled if debug flag .z is set |
c5670cb4 | 790 | |
0f345950 | 791 | and then not Debug_Flag_Dot_Z; |
f087ea44 | 792 | |
7b64b700 RD |
793 | -- Output warning if -gnateE specified and cannot be supported |
794 | ||
795 | if Exception_Extra_Info | |
796 | and then Restrict.No_Exception_Handlers_Set | |
797 | then | |
798 | Set_Standard_Error; | |
799 | Write_Str | |
800 | ("warning: extra exception information (-gnateE) was specified"); | |
801 | Write_Eol; | |
802 | Write_Str | |
803 | ("warning: this capability is not available in this configuration"); | |
804 | Write_Eol; | |
805 | Set_Standard_Output; | |
806 | end if; | |
807 | ||
dfb7345c | 808 | -- Enable or disable the support for 128-bit types. It is automatically |
ca5d8b90 | 809 | -- enabled if the back end supports them, unless -gnatd.H is specified. |
a5476382 | 810 | |
dfb7345c | 811 | Enable_128bit_Types := Ttypes.Standard_Long_Long_Long_Integer_Size = 128; |
a5476382 | 812 | |
ca5d8b90 EB |
813 | if Enable_128bit_Types and then Debug_Flag_Dot_HH then |
814 | Enable_128bit_Types := False; | |
815 | ||
816 | Ttypes.Standard_Long_Long_Long_Integer_Size := | |
817 | Ttypes.Standard_Long_Long_Integer_Size; | |
ca5d8b90 EB |
818 | Ttypes.System_Max_Integer_Size := |
819 | Ttypes.Standard_Long_Long_Integer_Size; | |
820 | Ttypes.System_Max_Binary_Modulus_Power := | |
821 | Ttypes.Standard_Long_Long_Integer_Size; | |
a5476382 EB |
822 | end if; |
823 | ||
224ae1c7 EB |
824 | -- Forcefully use a 32-bit Duration with only 32-bit integer types |
825 | ||
826 | if Ttypes.System_Max_Integer_Size < 64 then | |
827 | Targparm.Duration_32_Bits_On_Target := True; | |
828 | end if; | |
829 | ||
05b34c18 AC |
830 | -- Finally capture adjusted value of Suppress_Options as the initial |
831 | -- value for Scope_Suppress, which will be modified as we move from | |
832 | -- scope to scope (by Suppress/Unsuppress/Overflow_Checks pragmas). | |
833 | ||
834 | Sem.Scope_Suppress := Opt.Suppress_Options; | |
14e33999 AC |
835 | end Adjust_Global_Switches; |
836 | ||
804f7040 VC |
837 | -------------------- |
838 | -- Check_Bad_Body -- | |
839 | -------------------- | |
840 | ||
d030f3a4 AC |
841 | procedure Check_Bad_Body (Unit_Node : Node_Id; Unit_Kind : Node_Kind) is |
842 | Fname : File_Name_Type; | |
804f7040 VC |
843 | |
844 | procedure Bad_Body_Error (Msg : String); | |
845 | -- Issue message for bad body found | |
846 | ||
847 | -------------------- | |
848 | -- Bad_Body_Error -- | |
849 | -------------------- | |
850 | ||
851 | procedure Bad_Body_Error (Msg : String) is | |
852 | begin | |
d030f3a4 | 853 | Error_Msg_N (Msg, Unit_Node); |
804f7040 | 854 | Error_Msg_File_1 := Fname; |
d030f3a4 | 855 | Error_Msg_N ("remove incorrect body in file{!", Unit_Node); |
804f7040 VC |
856 | end Bad_Body_Error; |
857 | ||
d030f3a4 AC |
858 | -- Local variables |
859 | ||
860 | Sname : Unit_Name_Type; | |
861 | Src_Ind : Source_File_Index; | |
862 | ||
0d901290 | 863 | -- Start of processing for Check_Bad_Body |
804f7040 VC |
864 | |
865 | begin | |
866 | -- Nothing to do if we are only checking syntax, because we don't know | |
867 | -- enough to know if we require or forbid a body in this case. | |
868 | ||
869 | if Operating_Mode = Check_Syntax then | |
870 | return; | |
871 | end if; | |
872 | ||
873 | -- Check for body not allowed | |
874 | ||
d030f3a4 AC |
875 | if (Unit_Kind = N_Package_Declaration |
876 | and then not Body_Required (Unit_Node)) | |
877 | or else (Unit_Kind = N_Generic_Package_Declaration | |
878 | and then not Body_Required (Unit_Node)) | |
879 | or else Unit_Kind = N_Package_Renaming_Declaration | |
880 | or else Unit_Kind = N_Subprogram_Renaming_Declaration | |
881 | or else Nkind (Original_Node (Unit (Unit_Node))) | |
804f7040 VC |
882 | in N_Generic_Instantiation |
883 | then | |
884 | Sname := Unit_Name (Main_Unit); | |
885 | ||
886 | -- If we do not already have a body name, then get the body name | |
804f7040 VC |
887 | |
888 | if not Is_Body_Name (Sname) then | |
889 | Sname := Get_Body_Name (Sname); | |
890 | end if; | |
891 | ||
892 | Fname := Get_File_Name (Sname, Subunit => False); | |
893 | Src_Ind := Load_Source_File (Fname); | |
894 | ||
676e8420 AC |
895 | -- Case where body is present and it is not a subunit. Exclude the |
896 | -- subunit case, because it has nothing to do with the package we are | |
897 | -- compiling. It is illegal for a child unit and a subunit with the | |
898 | -- same expanded name (RM 10.2(9)) to appear together in a partition, | |
899 | -- but there is nothing to stop a compilation environment from having | |
900 | -- both, and the test here simply allows that. If there is an attempt | |
901 | -- to include both in a partition, this is diagnosed at bind time. In | |
902 | -- Ada 83 mode this is not a warning case. | |
903 | ||
da574a86 AC |
904 | -- Note that in general we do not give the message if the file in |
905 | -- question does not look like a body. This includes weird cases, | |
906 | -- but in particular means that if the file is just a No_Body pragma, | |
907 | -- then we won't give the message (that's the whole point of this | |
908 | -- pragma, to be used this way and to cause the body file to be | |
909 | -- ignored in this context). | |
804f7040 | 910 | |
cd644ae2 | 911 | if Src_Ind > No_Source_File |
da574a86 | 912 | and then Source_File_Is_Body (Src_Ind) |
804f7040 | 913 | then |
554846f3 | 914 | Errout.Finalize (Last_Call => False); |
804f7040 VC |
915 | |
916 | Error_Msg_Unit_1 := Sname; | |
917 | ||
918 | -- Ada 83 case of a package body being ignored. This is not an | |
919 | -- error as far as the Ada 83 RM is concerned, but it is almost | |
920 | -- certainly not what is wanted so output a warning. Give this | |
921 | -- message only if there were no errors, since otherwise it may | |
922 | -- be incorrect (we may have misinterpreted a junk spec as not | |
923 | -- needing a body when it really does). | |
924 | ||
d030f3a4 | 925 | if Unit_Kind = N_Package_Declaration |
804f7040 VC |
926 | and then Ada_Version = Ada_83 |
927 | and then Operating_Mode = Generate_Code | |
928 | and then Distribution_Stub_Mode /= Generate_Caller_Stub_Body | |
929 | and then not Compilation_Errors | |
930 | then | |
931 | Error_Msg_N | |
d030f3a4 | 932 | ("package $$ does not require a body??", Unit_Node); |
804f7040 | 933 | Error_Msg_File_1 := Fname; |
d030f3a4 | 934 | Error_Msg_N ("body in file{ will be ignored??", Unit_Node); |
804f7040 VC |
935 | |
936 | -- Ada 95 cases of a body file present when no body is | |
937 | -- permitted. This we consider to be an error. | |
938 | ||
939 | else | |
940 | -- For generic instantiations, we never allow a body | |
941 | ||
d030f3a4 | 942 | if Nkind (Original_Node (Unit (Unit_Node))) in |
da574a86 | 943 | N_Generic_Instantiation |
804f7040 VC |
944 | then |
945 | Bad_Body_Error | |
946 | ("generic instantiation for $$ does not allow a body"); | |
947 | ||
d030f3a4 | 948 | -- A library unit that is a renaming never allows a body |
804f7040 | 949 | |
d030f3a4 | 950 | elsif Unit_Kind in N_Renaming_Declaration then |
804f7040 VC |
951 | Bad_Body_Error |
952 | ("renaming declaration for $$ does not allow a body!"); | |
953 | ||
954 | -- Remaining cases are packages and generic packages. Here | |
955 | -- we only do the test if there are no previous errors, | |
956 | -- because if there are errors, they may lead us to | |
a90bd866 RD |
957 | -- incorrectly believe that a package does not allow a |
958 | -- body when in fact it does. | |
804f7040 VC |
959 | |
960 | elsif not Compilation_Errors then | |
d030f3a4 | 961 | if Unit_Kind = N_Package_Declaration then |
804f7040 VC |
962 | Bad_Body_Error |
963 | ("package $$ does not allow a body!"); | |
964 | ||
d030f3a4 | 965 | elsif Unit_Kind = N_Generic_Package_Declaration then |
804f7040 VC |
966 | Bad_Body_Error |
967 | ("generic package $$ does not allow a body!"); | |
968 | end if; | |
969 | end if; | |
970 | ||
971 | end if; | |
972 | end if; | |
973 | end if; | |
974 | end Check_Bad_Body; | |
975 | ||
75ba322d AC |
976 | -------------------- |
977 | -- Check_Rep_Info -- | |
978 | -------------------- | |
979 | ||
980 | procedure Check_Rep_Info is | |
981 | begin | |
982 | if List_Representation_Info /= 0 | |
983 | or else List_Representation_Info_Mechanisms | |
984 | then | |
985 | Set_Standard_Error; | |
986 | Write_Eol; | |
987 | Write_Str | |
988 | ("cannot generate representation information, no code generated"); | |
989 | Write_Eol; | |
990 | Write_Eol; | |
991 | Set_Standard_Output; | |
992 | end if; | |
993 | end Check_Rep_Info; | |
994 | ||
aca670a0 AC |
995 | ---------------------------------------- |
996 | -- Post_Compilation_Validation_Checks -- | |
997 | ---------------------------------------- | |
998 | ||
999 | procedure Post_Compilation_Validation_Checks is | |
1000 | begin | |
1001 | -- Validate alignment check warnings. In some cases we generate warnings | |
1002 | -- about possible alignment errors because we don't know the alignment | |
1003 | -- that will be chosen by the back end. This routine is in charge of | |
1004 | -- getting rid of those warnings if we can tell they are not needed. | |
1005 | ||
1006 | Checks.Validate_Alignment_Check_Warnings; | |
1007 | ||
a946a5c3 JM |
1008 | -- Validate compile time warnings and errors (using the values for size |
1009 | -- and alignment annotated by the backend where possible). We need to | |
1010 | -- unlock temporarily these tables to reanalyze their expression. | |
1011 | ||
ec225529 AC |
1012 | Atree.Unlock; |
1013 | Nlists.Unlock; | |
2d1439c7 | 1014 | Elists.Unlock; |
ec225529 | 1015 | Sem.Unlock; |
f56e04e8 | 1016 | Sem_Prag.Validate_Compile_Time_Warning_Errors; |
ec225529 | 1017 | Sem.Lock; |
2d1439c7 | 1018 | Elists.Lock; |
ec225529 AC |
1019 | Nlists.Lock; |
1020 | Atree.Lock; | |
a946a5c3 | 1021 | |
aca670a0 AC |
1022 | -- Validate unchecked conversions (using the values for size and |
1023 | -- alignment annotated by the backend where possible). | |
1024 | ||
1025 | Sem_Ch13.Validate_Unchecked_Conversions; | |
1026 | ||
1027 | -- Validate address clauses (again using alignment values annotated | |
1028 | -- by the backend where possible). | |
1029 | ||
1030 | Sem_Ch13.Validate_Address_Clauses; | |
aca670a0 AC |
1031 | end Post_Compilation_Validation_Checks; |
1032 | ||
6c165711 EB |
1033 | ----------------------------------- |
1034 | -- Read_JSON_Files_For_Repinfo -- | |
1035 | ----------------------------------- | |
1036 | ||
1037 | procedure Read_JSON_Files_For_Repinfo is | |
1038 | begin | |
1039 | -- This is the same loop construct as in Repinfo.List_Rep_Info | |
1040 | ||
1041 | for U in Main_Unit .. Last_Unit loop | |
1042 | if In_Extended_Main_Source_Unit (Cunit_Entity (U)) then | |
1043 | declare | |
29c64a0f HK |
1044 | Nam : constant String := |
1045 | Get_Name_String | |
1046 | (File_Name (Source_Index (U))) & ".json"; | |
1047 | Namid : constant File_Name_Type := Name_Enter (Nam); | |
6c165711 EB |
1048 | Index : constant Source_File_Index := Load_Config_File (Namid); |
1049 | ||
1050 | begin | |
1051 | if Index = No_Source_File then | |
1052 | Write_Str ("cannot locate "); | |
1053 | Write_Line (Nam); | |
1054 | raise Unrecoverable_Error; | |
1055 | end if; | |
1056 | ||
1057 | Repinfo.Input.Read_JSON_Stream (Source_Text (Index).all, Nam); | |
1058 | exception | |
1059 | when Repinfo.Input.Invalid_JSON_Stream => | |
1060 | raise Unrecoverable_Error; | |
1061 | end; | |
1062 | end if; | |
1063 | end loop; | |
1064 | end Read_JSON_Files_For_Repinfo; | |
1065 | ||
d030f3a4 AC |
1066 | -- Local variables |
1067 | ||
1068 | Back_End_Mode : Back_End.Back_End_Mode_Type; | |
dafe11cd | 1069 | Ecode : Exit_Code_Type; |
d030f3a4 AC |
1070 | |
1071 | Main_Unit_Kind : Node_Kind; | |
1072 | -- Kind of main compilation unit node | |
1073 | ||
1074 | Main_Unit_Node : Node_Id; | |
1075 | -- Compilation unit node for main unit | |
1076 | ||
804f7040 VC |
1077 | -- Start of processing for Gnat1drv |
1078 | ||
38cbfe40 RK |
1079 | begin |
1080 | -- This inner block is set up to catch assertion errors and constraint | |
1081 | -- errors. Since the code for handling these errors can cause another | |
1082 | -- exception to be raised (namely Unrecoverable_Error), we need two | |
1083 | -- nested blocks, so that the outer one handles unrecoverable error. | |
1084 | ||
1085 | begin | |
892125cd AC |
1086 | -- Initialize all packages. For the most part, these initialization |
1087 | -- calls can be made in any order. Exceptions are as follows: | |
1088 | ||
83dcc2bd | 1089 | -- Lib.Initialize needs to be called before Scan_Compiler_Arguments, |
804f7040 | 1090 | -- because it initializes a table filled by Scan_Compiler_Arguments. |
07fc65c4 | 1091 | |
fbf5a39b AC |
1092 | Osint.Initialize; |
1093 | Fmap.Reset_Tables; | |
07fc65c4 | 1094 | Lib.Initialize; |
fbf5a39b | 1095 | Lib.Xref.Initialize; |
38cbfe40 RK |
1096 | Scan_Compiler_Arguments; |
1097 | Osint.Add_Default_Search_Dirs; | |
28bc3323 | 1098 | Atree.Initialize; |
fbf5a39b | 1099 | Nlists.Initialize; |
38cbfe40 | 1100 | Sinput.Initialize; |
38cbfe40 | 1101 | Sem.Initialize; |
9c41193c | 1102 | Exp_CG.Initialize; |
38cbfe40 RK |
1103 | Csets.Initialize; |
1104 | Uintp.Initialize; | |
1105 | Urealp.Initialize; | |
1106 | Errout.Initialize; | |
240fe2a4 | 1107 | SCOs.Initialize; |
38cbfe40 RK |
1108 | Snames.Initialize; |
1109 | Stringt.Initialize; | |
8636f52f | 1110 | Ghost.Initialize; |
38cbfe40 | 1111 | Inline.Initialize; |
892125cd | 1112 | Par_SCO.Initialize; |
fbf5a39b AC |
1113 | Sem_Ch8.Initialize; |
1114 | Sem_Ch12.Initialize; | |
38cbfe40 | 1115 | Sem_Ch13.Initialize; |
9596236a | 1116 | Sem_Elim.Initialize; |
fbf5a39b AC |
1117 | Sem_Eval.Initialize; |
1118 | Sem_Type.Init_Interp_Tables; | |
1119 | ||
cc6f5d75 AC |
1120 | -- Capture compilation date and time |
1121 | ||
1122 | Opt.Compilation_Time := System.OS_Lib.Current_Time_String; | |
1123 | ||
24de083f AC |
1124 | -- Get the target parameters only when -gnats is not used, to avoid |
1125 | -- failing when there is no default runtime. | |
fbf5a39b | 1126 | |
24de083f | 1127 | if Operating_Mode /= Check_Syntax then |
fbf5a39b | 1128 | |
24de083f | 1129 | -- Acquire target parameters from system.ads (package System source) |
fbf5a39b | 1130 | |
24de083f | 1131 | Targparm_Acquire : declare |
fbf5a39b | 1132 | |
24de083f AC |
1133 | S : Source_File_Index; |
1134 | N : File_Name_Type; | |
fbf5a39b | 1135 | |
24de083f AC |
1136 | begin |
1137 | Name_Buffer (1 .. 10) := "system.ads"; | |
1138 | Name_Len := 10; | |
1139 | N := Name_Find; | |
1140 | S := Load_Source_File (N); | |
fbf5a39b | 1141 | |
24de083f | 1142 | -- Failed to read system.ads, fatal error |
38cbfe40 | 1143 | |
24de083f AC |
1144 | if S = No_Source_File then |
1145 | Write_Line | |
1146 | ("fatal error, run-time library not installed correctly"); | |
1147 | Write_Line ("cannot locate file system.ads"); | |
1148 | raise Unrecoverable_Error; | |
7f5e671b | 1149 | |
cd644ae2 PMR |
1150 | elsif S = No_Access_To_Source_File then |
1151 | Write_Line | |
1152 | ("fatal error, run-time library not installed correctly"); | |
1153 | Write_Line ("no read access for file system.ads"); | |
1154 | raise Unrecoverable_Error; | |
07fc65c4 | 1155 | |
24de083f AC |
1156 | -- Read system.ads successfully, remember its source index |
1157 | ||
1158 | else | |
1159 | System_Source_File_Index := S; | |
1160 | end if; | |
07fc65c4 | 1161 | |
596b25f9 | 1162 | -- Call to get target parameters. Note that the actual interface |
b68cf874 AC |
1163 | -- routines are in Tbuild. They can't be in this procedure because |
1164 | -- of accessibility issues. | |
596b25f9 | 1165 | |
24de083f AC |
1166 | Targparm.Get_Target_Parameters |
1167 | (System_Text => Source_Text (S), | |
1168 | Source_First => Source_First (S), | |
1169 | Source_Last => Source_Last (S), | |
1170 | Make_Id => Tbuild.Make_Id'Access, | |
1171 | Make_SC => Tbuild.Make_SC'Access, | |
596b25f9 AC |
1172 | Set_NOD => Tbuild.Set_NOD'Access, |
1173 | Set_NSA => Tbuild.Set_NSA'Access, | |
1174 | Set_NUA => Tbuild.Set_NUA'Access, | |
1175 | Set_NUP => Tbuild.Set_NUP'Access); | |
24de083f AC |
1176 | |
1177 | -- Acquire configuration pragma information from Targparm | |
1178 | ||
1179 | Restrict.Restrictions := Targparm.Restrictions_On_Target; | |
1180 | end Targparm_Acquire; | |
1181 | end if; | |
28bc3323 AC |
1182 | |
1183 | -- Perform various adjustments and settings of global switches | |
fbf5a39b | 1184 | |
14e33999 | 1185 | Adjust_Global_Switches; |
554846f3 | 1186 | |
4ecc031c | 1187 | -- Output copyright notice if full list mode unless we have a list |
24de083f | 1188 | -- file, in which case we defer this so that it is output in the file. |
38cbfe40 | 1189 | |
804f7040 | 1190 | if (Verbose_Mode or else (Full_List and then Full_List_File_Name = null)) |
24de083f AC |
1191 | |
1192 | -- Debug flag gnatd7 suppresses this copyright notice | |
1193 | ||
4ecc031c | 1194 | and then not Debug_Flag_7 |
38cbfe40 RK |
1195 | then |
1196 | Write_Eol; | |
1197 | Write_Str ("GNAT "); | |
07fc65c4 | 1198 | Write_Str (Gnat_Version_String); |
87b62748 | 1199 | Write_Eol; |
0d901290 AC |
1200 | Write_Str ("Copyright 1992-" & Current_Year |
1201 | & ", Free Software Foundation, Inc."); | |
07fc65c4 | 1202 | Write_Eol; |
38cbfe40 RK |
1203 | end if; |
1204 | ||
804f7040 VC |
1205 | -- Check we do not have more than one source file, this happens only in |
1206 | -- the case where the driver is called directly, it cannot happen when | |
1207 | -- gnat1 is invoked from gcc in the normal case. | |
38cbfe40 RK |
1208 | |
1209 | if Osint.Number_Of_Files /= 1 then | |
5fc26697 YM |
1210 | |
1211 | -- In GNATprove mode, gcc is not called, so we may end up with | |
1212 | -- switches wrongly interpreted as source file names when they are | |
1213 | -- written by mistake without a starting hyphen. Issue a specific | |
1214 | -- error message but do not print the internal 'usage' message. | |
1215 | ||
1216 | if GNATprove_Mode then | |
2401c98f HK |
1217 | Write_Str |
1218 | ("one of the following is not a valid switch or source file " | |
1219 | & "name: "); | |
5fc26697 YM |
1220 | Osint.Dump_Command_Line_Source_File_Names; |
1221 | else | |
1222 | Usage; | |
1223 | Write_Eol; | |
1224 | end if; | |
1225 | ||
38cbfe40 RK |
1226 | Osint.Fail ("you must provide one source file"); |
1227 | ||
1228 | elsif Usage_Requested then | |
1229 | Usage; | |
1230 | end if; | |
1231 | ||
289a994b AC |
1232 | -- Generate target dependent output file if requested |
1233 | ||
340772c0 | 1234 | if Target_Dependent_Info_Write_Name /= null then |
289a994b AC |
1235 | Set_Targ.Write_Target_Dependent_Values; |
1236 | end if; | |
1237 | ||
1238 | -- Call the front end | |
1239 | ||
38cbfe40 RK |
1240 | Original_Operating_Mode := Operating_Mode; |
1241 | Frontend; | |
38cbfe40 | 1242 | |
a2667f14 | 1243 | -- Exit with errors if the main source could not be parsed |
1a07a71a | 1244 | |
cd644ae2 | 1245 | if Sinput.Main_Source_File <= No_Source_File then |
554846f3 | 1246 | Errout.Finalize (Last_Call => True); |
804f7040 VC |
1247 | Errout.Output_Messages; |
1248 | Exit_Program (E_Errors); | |
38cbfe40 RK |
1249 | end if; |
1250 | ||
804f7040 | 1251 | Main_Unit_Node := Cunit (Main_Unit); |
d030f3a4 AC |
1252 | Main_Unit_Kind := Nkind (Unit (Main_Unit_Node)); |
1253 | ||
1254 | Check_Bad_Body (Main_Unit_Node, Main_Unit_Kind); | |
804f7040 | 1255 | |
5e12215f AC |
1256 | -- In CodePeer mode we always delete old SCIL files before regenerating |
1257 | -- new ones, in case of e.g. errors, and also to remove obsolete scilx | |
1258 | -- files generated by CodePeer itself. | |
1259 | ||
1260 | if CodePeer_Mode then | |
1261 | Comperr.Delete_SCIL_Files; | |
1262 | end if; | |
1263 | ||
520c0201 AC |
1264 | -- Ditto for old C files before regenerating new ones |
1265 | ||
1266 | if Generate_C_Code then | |
1267 | Delete_C_File; | |
1268 | Delete_H_File; | |
1269 | end if; | |
1270 | ||
38cbfe40 RK |
1271 | -- Exit if compilation errors detected |
1272 | ||
554846f3 | 1273 | Errout.Finalize (Last_Call => False); |
804f7040 | 1274 | |
38cbfe40 RK |
1275 | if Compilation_Errors then |
1276 | Treepr.Tree_Dump; | |
aca670a0 | 1277 | Post_Compilation_Validation_Checks; |
d0567dc0 | 1278 | Errout.Finalize (Last_Call => True); |
804f7040 | 1279 | Errout.Output_Messages; |
38cbfe40 RK |
1280 | Namet.Finalize; |
1281 | ||
1282 | -- Generate ALI file if specially requested | |
1283 | ||
ba203461 | 1284 | if Opt.Force_ALI_File then |
38cbfe40 | 1285 | Write_ALI (Object => False); |
38cbfe40 RK |
1286 | end if; |
1287 | ||
1288 | Exit_Program (E_Errors); | |
1289 | end if; | |
1290 | ||
448f2610 AC |
1291 | -- Set Generate_Code on main unit and its spec. We do this even if are |
1292 | -- not generating code, since Lib-Writ uses this to determine which | |
1293 | -- units get written in the ali file. | |
38cbfe40 RK |
1294 | |
1295 | Set_Generate_Code (Main_Unit); | |
1296 | ||
0d901290 AC |
1297 | -- If we have a corresponding spec, and it comes from source or it is |
1298 | -- not a generated spec for a child subprogram body, then we need object | |
1299 | -- code for the spec unit as well. | |
38cbfe40 RK |
1300 | |
1301 | if Nkind (Unit (Main_Unit_Node)) in N_Unit_Body | |
1302 | and then not Acts_As_Spec (Main_Unit_Node) | |
1303 | then | |
3a69b5ff | 1304 | if Nkind (Unit (Main_Unit_Node)) = N_Subprogram_Body |
f3a67cfc ES |
1305 | and then not Comes_From_Source (Library_Unit (Main_Unit_Node)) |
1306 | then | |
1307 | null; | |
1308 | else | |
1309 | Set_Generate_Code | |
1310 | (Get_Cunit_Unit_Number (Library_Unit (Main_Unit_Node))); | |
1311 | end if; | |
38cbfe40 RK |
1312 | end if; |
1313 | ||
38cbfe40 RK |
1314 | -- Case of no code required to be generated, exit indicating no error |
1315 | ||
1316 | if Original_Operating_Mode = Check_Syntax then | |
1317 | Treepr.Tree_Dump; | |
554846f3 | 1318 | Errout.Finalize (Last_Call => True); |
804f7040 | 1319 | Errout.Output_Messages; |
38cbfe40 | 1320 | Namet.Finalize; |
804f7040 | 1321 | Check_Rep_Info; |
3a0462b3 RD |
1322 | |
1323 | -- Use a goto instead of calling Exit_Program so that finalization | |
1324 | -- occurs normally. | |
1325 | ||
1326 | goto End_Of_Program; | |
38cbfe40 RK |
1327 | |
1328 | elsif Original_Operating_Mode = Check_Semantics then | |
1329 | Back_End_Mode := Declarations_Only; | |
1330 | ||
1331 | -- All remaining cases are cases in which the user requested that code | |
0d901290 AC |
1332 | -- be generated (i.e. no -gnatc or -gnats switch was used). Check if we |
1333 | -- can in fact satisfy this request. | |
38cbfe40 | 1334 | |
448f2610 AC |
1335 | -- Cannot generate code if someone has turned off code generation for |
1336 | -- any reason at all. We will try to figure out a reason below. | |
38cbfe40 RK |
1337 | |
1338 | elsif Operating_Mode /= Generate_Code then | |
1339 | Back_End_Mode := Skip; | |
1340 | ||
448f2610 AC |
1341 | -- We can generate code for a subprogram body unless there were missing |
1342 | -- subunits. Note that we always generate code for all generic units (a | |
1343 | -- change from some previous versions of GNAT). | |
38cbfe40 | 1344 | |
d030f3a4 AC |
1345 | elsif Main_Unit_Kind = N_Subprogram_Body |
1346 | and then not Subunits_Missing | |
1347 | then | |
38cbfe40 RK |
1348 | Back_End_Mode := Generate_Object; |
1349 | ||
fbf5a39b AC |
1350 | -- We can generate code for a package body unless there are subunits |
1351 | -- missing (note that we always generate code for generic units, which | |
1352 | -- is a change from some earlier versions of GNAT). | |
38cbfe40 | 1353 | |
d030f3a4 | 1354 | elsif Main_Unit_Kind = N_Package_Body and then not Subunits_Missing then |
38cbfe40 RK |
1355 | Back_End_Mode := Generate_Object; |
1356 | ||
1357 | -- We can generate code for a package declaration or a subprogram | |
1358 | -- declaration only if it does not required a body. | |
1359 | ||
4a08c95c | 1360 | elsif Main_Unit_Kind in N_Package_Declaration | N_Subprogram_Declaration |
38cbfe40 RK |
1361 | and then |
1362 | (not Body_Required (Main_Unit_Node) | |
32b794c8 | 1363 | or else Distribution_Stub_Mode = Generate_Caller_Stub_Body) |
38cbfe40 RK |
1364 | then |
1365 | Back_End_Mode := Generate_Object; | |
1366 | ||
1367 | -- We can generate code for a generic package declaration of a generic | |
fbf5a39b | 1368 | -- subprogram declaration only if does not require a body. |
38cbfe40 | 1369 | |
4a08c95c AC |
1370 | elsif Main_Unit_Kind in |
1371 | N_Generic_Package_Declaration | N_Generic_Subprogram_Declaration | |
38cbfe40 | 1372 | and then not Body_Required (Main_Unit_Node) |
38cbfe40 RK |
1373 | then |
1374 | Back_End_Mode := Generate_Object; | |
1375 | ||
0d901290 AC |
1376 | -- Compilation units that are renamings do not require bodies, so we can |
1377 | -- generate code for them. | |
38cbfe40 | 1378 | |
4a08c95c AC |
1379 | elsif Main_Unit_Kind in N_Package_Renaming_Declaration | |
1380 | N_Subprogram_Renaming_Declaration | |
38cbfe40 RK |
1381 | then |
1382 | Back_End_Mode := Generate_Object; | |
1383 | ||
1384 | -- Compilation units that are generic renamings do not require bodies | |
fbf5a39b | 1385 | -- so we can generate code for them. |
38cbfe40 | 1386 | |
d030f3a4 | 1387 | elsif Main_Unit_Kind in N_Generic_Renaming_Declaration then |
38cbfe40 RK |
1388 | Back_End_Mode := Generate_Object; |
1389 | ||
533369aa AC |
1390 | -- It is not an error to analyze in CodePeer mode a spec which requires |
1391 | -- a body, in order to generate SCIL for this spec. | |
1be9633f | 1392 | |
d145e562 | 1393 | elsif CodePeer_Mode then |
1be9633f AC |
1394 | Back_End_Mode := Generate_Object; |
1395 | ||
d145e562 AC |
1396 | -- Differentiate use of -gnatceg to generate a C header from an Ada spec |
1397 | -- to the CCG case (standard.h found) where C code generation should | |
1398 | -- only be performed on full units. | |
1399 | ||
1400 | elsif Generate_C_Code then | |
1401 | Name_Len := 10; | |
1402 | Name_Buffer (1 .. Name_Len) := "standard.h"; | |
1403 | ||
1404 | if Find_File (Name_Find, Osint.Source, Full_Name => True) = No_File | |
1405 | then | |
1406 | Back_End_Mode := Generate_Object; | |
1407 | else | |
1408 | Back_End_Mode := Skip; | |
1409 | end if; | |
1410 | ||
f5da7a97 YM |
1411 | -- It is not an error to analyze in GNATprove mode a spec which requires |
1412 | -- a body, when the body is not available. During frame condition | |
533369aa | 1413 | -- generation, the corresponding ALI file is generated. During |
aca90db9 | 1414 | -- analysis, the spec is analyzed. |
533369aa | 1415 | |
f5da7a97 YM |
1416 | elsif GNATprove_Mode then |
1417 | Back_End_Mode := Declarations_Only; | |
533369aa | 1418 | |
38cbfe40 RK |
1419 | -- In all other cases (specs which have bodies, generics, and bodies |
1420 | -- where subunits are missing), we cannot generate code and we generate | |
1421 | -- a warning message. Note that generic instantiations are gone at this | |
1422 | -- stage since they have been replaced by their instances. | |
1423 | ||
1424 | else | |
1425 | Back_End_Mode := Skip; | |
1426 | end if; | |
1427 | ||
c09a557e AC |
1428 | -- At this stage Back_End_Mode is set to indicate if the backend should |
1429 | -- be called to generate code. If it is Skip, then code generation has | |
1430 | -- been turned off, even though code was requested by the original | |
448f2610 AC |
1431 | -- command. This is not an error from the user point of view, but it is |
1432 | -- an error from the point of view of the gcc driver, so we must exit | |
1433 | -- with an error status. | |
38cbfe40 | 1434 | |
448f2610 AC |
1435 | -- We generate an informative message (from the gcc point of view, it |
1436 | -- is an error message, but from the users point of view this is not an | |
1437 | -- error, just a consequence of compiling something that cannot | |
1438 | -- generate code). | |
38cbfe40 RK |
1439 | |
1440 | if Back_End_Mode = Skip then | |
38cbfe40 | 1441 | |
d030f3a4 AC |
1442 | -- An ignored Ghost unit is rewritten into a null statement because |
1443 | -- it must not produce an ALI or object file. Do not emit any errors | |
1444 | -- related to code generation because the unit does not exist. | |
38cbfe40 | 1445 | |
dafe11cd HK |
1446 | if Is_Ignored_Ghost_Unit (Main_Unit_Node) then |
1447 | ||
1448 | -- Exit the gnat driver with success, otherwise external builders | |
1449 | -- such as gnatmake and gprbuild will treat the compilation of an | |
1450 | -- ignored Ghost unit as a failure. Note that this will produce | |
1451 | -- an empty object file for the unit. | |
1452 | ||
1453 | Ecode := E_Success; | |
81eb625c | 1454 | |
d030f3a4 AC |
1455 | -- Otherwise the unit is missing a crucial piece that prevents code |
1456 | -- generation. | |
81eb625c | 1457 | |
d030f3a4 | 1458 | else |
dafe11cd HK |
1459 | Ecode := E_No_Code; |
1460 | ||
d030f3a4 AC |
1461 | Set_Standard_Error; |
1462 | Write_Str ("cannot generate code for file "); | |
1463 | Write_Name (Unit_File_Name (Main_Unit)); | |
38cbfe40 | 1464 | |
d030f3a4 AC |
1465 | if Subunits_Missing then |
1466 | Write_Str (" (missing subunits)"); | |
1467 | Write_Eol; | |
81eb625c | 1468 | |
d030f3a4 | 1469 | -- Force generation of ALI file, for backward compatibility |
81eb625c | 1470 | |
ba203461 | 1471 | Opt.Force_ALI_File := True; |
fbf5a39b | 1472 | |
d030f3a4 AC |
1473 | elsif Main_Unit_Kind = N_Subunit then |
1474 | Write_Str (" (subunit)"); | |
1475 | Write_Eol; | |
fbf5a39b | 1476 | |
cc3a2986 AC |
1477 | -- Do not generate an ALI file in this case, because it would |
1478 | -- become obsolete when the parent is compiled, and thus | |
1479 | -- confuse tools such as gnatfind. | |
81eb625c | 1480 | |
d030f3a4 AC |
1481 | elsif Main_Unit_Kind = N_Subprogram_Declaration then |
1482 | Write_Str (" (subprogram spec)"); | |
1483 | Write_Eol; | |
81eb625c | 1484 | |
d030f3a4 | 1485 | -- Generic package body in GNAT implementation mode |
38cbfe40 | 1486 | |
d030f3a4 AC |
1487 | elsif Main_Unit_Kind = N_Package_Body and then GNAT_Mode then |
1488 | Write_Str (" (predefined generic)"); | |
1489 | Write_Eol; | |
1490 | ||
1491 | -- Force generation of ALI file, for backward compatibility | |
1492 | ||
ba203461 | 1493 | Opt.Force_ALI_File := True; |
d030f3a4 AC |
1494 | |
1495 | -- Only other case is a package spec | |
1496 | ||
1497 | else | |
1498 | Write_Str (" (package spec)"); | |
1499 | Write_Eol; | |
1500 | end if; | |
fbf5a39b AC |
1501 | end if; |
1502 | ||
8f3366c6 | 1503 | Set_Standard_Output; |
38cbfe40 | 1504 | |
aca670a0 | 1505 | Post_Compilation_Validation_Checks; |
554846f3 | 1506 | Errout.Finalize (Last_Call => True); |
804f7040 | 1507 | Errout.Output_Messages; |
38cbfe40 | 1508 | Treepr.Tree_Dump; |
81eb625c AC |
1509 | |
1510 | -- Generate ALI file if specially requested, or for missing subunits, | |
af3ded08 | 1511 | -- subunits or predefined generic. For ignored ghost code, the object |
647abeaf BD |
1512 | -- file IS generated, so Object should be True, and since the object |
1513 | -- file is generated, we need to generate the ALI file. We never want | |
1514 | -- an object file without an ALI file. | |
81eb625c | 1515 | |
647abeaf | 1516 | if Is_Ignored_Ghost_Unit (Main_Unit_Node) |
ba203461 | 1517 | or else Opt.Force_ALI_File |
647abeaf | 1518 | then |
af3ded08 | 1519 | Write_ALI (Object => Is_Ignored_Ghost_Unit (Main_Unit_Node)); |
81eb625c AC |
1520 | end if; |
1521 | ||
38cbfe40 | 1522 | Namet.Finalize; |
804f7040 | 1523 | Check_Rep_Info; |
38cbfe40 | 1524 | |
dafe11cd HK |
1525 | -- Exit the driver with an appropriate status indicator. This will |
1526 | -- generate an empty object file for ignored Ghost units, otherwise | |
1527 | -- no object file will be generated. | |
38cbfe40 | 1528 | |
dafe11cd | 1529 | Exit_Program (Ecode); |
38cbfe40 RK |
1530 | end if; |
1531 | ||
ba203461 AC |
1532 | -- In -gnatc mode we only do annotation if -gnatR is also set, or if |
1533 | -- -gnatwz is enabled (default setting) and there is an unchecked | |
e194729e | 1534 | -- conversion that involves a type whose size is not statically known, |
676e8420 | 1535 | -- as indicated by Back_Annotate_Rep_Info being set to True. |
38cbfe40 RK |
1536 | |
1537 | -- We don't call for annotations on a subunit, because to process those | |
2cc2e964 | 1538 | -- the back end requires that the parent(s) be properly compiled. |
38cbfe40 | 1539 | |
427024ae GD |
1540 | -- Annotation is suppressed for targets where front-end layout is |
1541 | -- enabled, because the front end determines representations. | |
1542 | ||
a1971119 YM |
1543 | -- A special back end is always called in CodePeer and GNATprove modes, |
1544 | -- unless this is a subunit. | |
1545 | ||
38cbfe40 | 1546 | if Back_End_Mode = Declarations_Only |
4a28b181 AC |
1547 | and then |
1548 | (not (Back_Annotate_Rep_Info or Generate_SCIL or GNATprove_Mode) | |
65f1ca2e | 1549 | or else Main_Unit_Kind = N_Subunit) |
38cbfe40 | 1550 | then |
aca670a0 | 1551 | Post_Compilation_Validation_Checks; |
554846f3 | 1552 | Errout.Finalize (Last_Call => True); |
804f7040 | 1553 | Errout.Output_Messages; |
38cbfe40 RK |
1554 | Write_ALI (Object => False); |
1555 | Tree_Dump; | |
38cbfe40 | 1556 | Namet.Finalize; |
a1971119 YM |
1557 | |
1558 | if not (Generate_SCIL or GNATprove_Mode) then | |
1559 | Check_Rep_Info; | |
1560 | end if; | |
1561 | ||
38cbfe40 RK |
1562 | return; |
1563 | end if; | |
1564 | ||
448f2610 AC |
1565 | -- Ensure that we properly register a dependency on system.ads, since |
1566 | -- even if we do not semantically depend on this, Targparm has read | |
1567 | -- system parameters from the system.ads file. | |
38cbfe40 RK |
1568 | |
1569 | Lib.Writ.Ensure_System_Dependency; | |
1570 | ||
fbf5a39b AC |
1571 | -- Add dependencies, if any, on preprocessing data file and on |
1572 | -- preprocessing definition file(s). | |
1573 | ||
1574 | Prepcomp.Add_Dependencies; | |
1575 | ||
7b536495 AC |
1576 | if GNATprove_Mode then |
1577 | ||
fb69239a AC |
1578 | -- In GNATprove mode we're writing the ALI much earlier than usual |
1579 | -- as flow analysis needs the file present in order to append its | |
1580 | -- own globals to it. | |
1581 | ||
7b536495 AC |
1582 | -- Note: In GNATprove mode, an "object" file is always generated as |
1583 | -- the result of calling gnat1 or gnat2why, although this is not the | |
1584 | -- same as the object file produced for compilation. | |
1585 | ||
1586 | Write_ALI (Object => True); | |
1587 | end if; | |
1588 | ||
0566484a AC |
1589 | -- Some back ends (for instance Gigi) are known to rely on SCOs for code |
1590 | -- generation. Make sure they are available. | |
1591 | ||
1592 | if Generate_SCO then | |
1593 | Par_SCO.SCO_Record_Filtered; | |
1594 | end if; | |
6c165711 EB |
1595 | |
1596 | -- If -gnatd_j is specified, exercise the JSON parser of Repinfo | |
1597 | ||
1598 | if Debug_Flag_Underscore_J then | |
1599 | Read_JSON_Files_For_Repinfo; | |
1600 | end if; | |
0566484a | 1601 | |
38cbfe40 RK |
1602 | -- Back end needs to explicitly unlock tables it needs to touch |
1603 | ||
1604 | Atree.Lock; | |
1605 | Elists.Lock; | |
1606 | Fname.UF.Lock; | |
8636f52f | 1607 | Ghost.Lock; |
38cbfe40 RK |
1608 | Inline.Lock; |
1609 | Lib.Lock; | |
8636f52f | 1610 | Namet.Lock; |
38cbfe40 RK |
1611 | Nlists.Lock; |
1612 | Sem.Lock; | |
1613 | Sinput.Lock; | |
38cbfe40 RK |
1614 | Stringt.Lock; |
1615 | ||
fbf5a39b | 1616 | -- Here we call the back end to generate the output code |
38cbfe40 | 1617 | |
804f7040 | 1618 | Generating_Code := True; |
38cbfe40 RK |
1619 | Back_End.Call_Back_End (Back_End_Mode); |
1620 | ||
448f2610 | 1621 | -- Once the backend is complete, we unlock the names table. This call |
549cc9c2 AC |
1622 | -- allows a few extra entries, needed for example for the file name |
1623 | -- for the library file output. | |
38cbfe40 RK |
1624 | |
1625 | Namet.Unlock; | |
1626 | ||
9c41193c JM |
1627 | -- Generate the call-graph output of dispatching calls |
1628 | ||
1629 | Exp_CG.Generate_CG_Output; | |
1630 | ||
aca670a0 | 1631 | -- Perform post compilation validation checks |
2642f998 | 1632 | |
aca670a0 | 1633 | Post_Compilation_Validation_Checks; |
105b5e65 | 1634 | |
448f2610 AC |
1635 | -- Now we complete output of errors, rep info and the tree info. These |
1636 | -- are delayed till now, since it is perfectly possible for gigi to | |
1637 | -- generate errors, modify the tree (in particular by setting flags | |
1638 | -- indicating that elaboration is required, and also to back annotate | |
42e2600a | 1639 | -- representation information for List_Rep_Info). |
38cbfe40 | 1640 | |
554846f3 | 1641 | Errout.Finalize (Last_Call => True); |
804f7040 | 1642 | Errout.Output_Messages; |
e194729e | 1643 | Repinfo.List_Rep_Info (Ttypes.Bytes_Big_Endian); |
16b10ccc | 1644 | Inline.List_Inlining_Info; |
38cbfe40 RK |
1645 | |
1646 | -- Only write the library if the backend did not generate any error | |
1647 | -- messages. Otherwise signal errors to the driver program so that | |
1648 | -- there will be no attempt to generate an object file. | |
1649 | ||
1650 | if Compilation_Errors then | |
1651 | Treepr.Tree_Dump; | |
1652 | Exit_Program (E_Errors); | |
1653 | end if; | |
1654 | ||
7b536495 AC |
1655 | if not GNATprove_Mode then |
1656 | Write_ALI (Object => (Back_End_Mode = Generate_Object)); | |
1657 | end if; | |
38cbfe40 | 1658 | |
a0fb8fe8 | 1659 | if not Compilation_Errors then |
a4640a39 | 1660 | |
a0fb8fe8 | 1661 | -- In case of ada backends, we need to make sure that the generated |
a4640a39 AC |
1662 | -- object file has a timestamp greater than the ALI file. We do this |
1663 | -- to make gnatmake happy when checking the ALI and obj timestamps, | |
1664 | -- where it expects the object file being written after the ali file. | |
1665 | ||
a0fb8fe8 AC |
1666 | -- Gnatmake's assumption is true for gcc platforms where the gcc |
1667 | -- wrapper needs to call the assembler after calling gnat1, but is | |
1668 | -- not true for ada backends, where the object files are created | |
1669 | -- directly by gnat1 (so are created before the ali file). | |
a4640a39 | 1670 | |
a0fb8fe8 AC |
1671 | Back_End.Gen_Or_Update_Object_File; |
1672 | end if; | |
1673 | ||
65f1ca2e AC |
1674 | -- Generate tree after writing the ALI file, since Write_ALI may in |
1675 | -- fact result in further tree decoration from the original tree file. | |
1676 | -- Note that we dump the tree just before generating it, so that the | |
1677 | -- dump will exactly reflect what is written out. | |
38cbfe40 RK |
1678 | |
1679 | Treepr.Tree_Dump; | |
38cbfe40 RK |
1680 | |
1681 | -- Finalize name table and we are all done | |
1682 | ||
1683 | Namet.Finalize; | |
1684 | ||
1685 | exception | |
1686 | -- Handle fatal internal compiler errors | |
1687 | ||
804f7040 VC |
1688 | when Rtsfind.RE_Not_Available => |
1689 | Comperr.Compiler_Abort ("RE_Not_Available"); | |
1690 | ||
38cbfe40 RK |
1691 | when System.Assertions.Assert_Failure => |
1692 | Comperr.Compiler_Abort ("Assert_Failure"); | |
1693 | ||
1694 | when Constraint_Error => | |
1695 | Comperr.Compiler_Abort ("Constraint_Error"); | |
1696 | ||
1697 | when Program_Error => | |
1698 | Comperr.Compiler_Abort ("Program_Error"); | |
1699 | ||
d030f3a4 AC |
1700 | -- Assume this is a bug. If it is real, the message will in any case |
1701 | -- say Storage_Error, giving a strong hint. | |
38cbfe40 | 1702 | |
d030f3a4 | 1703 | when Storage_Error => |
38cbfe40 | 1704 | Comperr.Compiler_Abort ("Storage_Error"); |
0489576c AC |
1705 | |
1706 | when Unrecoverable_Error => | |
1707 | raise; | |
1708 | ||
1709 | when others => | |
1710 | Comperr.Compiler_Abort ("exception"); | |
38cbfe40 RK |
1711 | end; |
1712 | ||
3a0462b3 | 1713 | <<End_Of_Program>> |
83dcc2bd | 1714 | |
d030f3a4 | 1715 | -- The outer exception handler handles an unrecoverable error |
38cbfe40 RK |
1716 | |
1717 | exception | |
1718 | when Unrecoverable_Error => | |
554846f3 | 1719 | Errout.Finalize (Last_Call => True); |
804f7040 | 1720 | Errout.Output_Messages; |
38cbfe40 RK |
1721 | |
1722 | Set_Standard_Error; | |
1723 | Write_Str ("compilation abandoned"); | |
1724 | Write_Eol; | |
1725 | ||
1726 | Set_Standard_Output; | |
1727 | Source_Dump; | |
1728 | Tree_Dump; | |
1729 | Exit_Program (E_Errors); | |
1730 | ||
1731 | end Gnat1drv; |