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