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