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