1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
27 with Back_End
; use Back_End
;
30 with Csets
; use Csets
;
31 with Debug
; use Debug
;
33 with Errout
; use Errout
;
36 with Fname
; use Fname
;
37 with Fname
.UF
; use Fname
.UF
;
39 with Gnatvsn
; use Gnatvsn
;
42 with Lib
.Writ
; use Lib
.Writ
;
44 with Namet
; use Namet
;
47 with Osint
; use Osint
;
48 with Output
; use Output
;
51 with Repinfo
; use Repinfo
;
53 with Rident
; use Rident
;
64 with Sinfo
; use Sinfo
;
65 with Sinput
.L
; use Sinput
.L
;
67 with Sprint
; use Sprint
;
69 with Stylesw
; use Stylesw
;
70 with Targparm
; use Targparm
;
73 with Treepr
; use Treepr
;
75 with Types
; use Types
;
76 with Uintp
; use Uintp
;
77 with Uname
; use Uname
;
80 with Validsw
; use Validsw
;
82 with System
.Assertions
;
90 Main_Unit_Node
: Node_Id
;
91 -- Compilation unit node for main unit
93 Main_Kind
: Node_Kind
;
94 -- Kind of main compilation unit node
96 Back_End_Mode
: Back_End
.Back_End_Mode_Type
;
97 -- Record back end mode
99 procedure Adjust_Global_Switches
;
100 -- There are various interactions between front end switch settings,
101 -- including debug switch settings and target dependent parameters.
102 -- This procedure takes care of properly handling these interactions.
103 -- We do it after scanning out all the switches, so that we are not
104 -- depending on the order in which switches appear.
106 procedure Check_Bad_Body
;
107 -- Called to check if the unit we are compiling has a bad body
109 procedure Check_Rep_Info
;
110 -- Called when we are not generating code, to check if -gnatR was requested
111 -- and if so, explain that we will not be honoring the request.
113 procedure Post_Compilation_Validation_Checks
;
114 -- This procedure performs various validation checks that have to be left
115 -- to the end of the compilation process, after generating code but before
116 -- issuing error messages. In particular, these checks generally require
117 -- the information provided by the back end in back annotation of declared
118 -- entities (e.g. actual size and alignment values chosen by the back end).
120 ----------------------------
121 -- Adjust_Global_Switches --
122 ----------------------------
124 procedure Adjust_Global_Switches
is
126 -- -gnatd.M enables Relaxed_RM_Semantics
128 if Debug_Flag_Dot_MM
then
129 Relaxed_RM_Semantics
:= True;
132 -- -gnatd.V or -gnatd.u enables special C expansion mode
134 if Debug_Flag_Dot_VV
or Debug_Flag_Dot_U
then
135 Modify_Tree_For_C
:= True;
138 -- -gnatd.E sets Error_To_Warning mode, causing selected error messages
139 -- to be treated as warnings instead of errors.
141 if Debug_Flag_Dot_EE
then
142 Error_To_Warning
:= True;
145 -- Disable CodePeer_Mode in Check_Syntax, since we need front-end
148 if Operating_Mode
= Check_Syntax
then
149 CodePeer_Mode
:= False;
152 -- Set ASIS mode if -gnatt and -gnatc are set
154 if Operating_Mode
= Check_Semantics
and then Tree_Output
then
157 -- Turn off inlining in ASIS mode, since ASIS cannot handle the extra
158 -- information in the trees caused by inlining being active.
160 -- More specifically, the tree seems to be malformed from the ASIS
161 -- point of view if -gnatc and -gnatn appear together???
163 Inline_Active
:= False;
165 -- Turn off SCIL generation and CodePeer mode in semantics mode,
166 -- since SCIL requires front-end expansion.
168 Generate_SCIL
:= False;
169 CodePeer_Mode
:= False;
172 -- SCIL mode needs to disable front-end inlining since the generated
173 -- trees (in particular order and consistency between specs compiled
174 -- as part of a main unit or as part of a with-clause) are causing
177 if Generate_SCIL
then
178 Front_End_Inlining
:= False;
181 -- Tune settings for optimal SCIL generation in CodePeer mode
183 if CodePeer_Mode
then
185 -- Turn off gnatprove mode (which can be set via e.g. -gnatd.F), not
186 -- compatible with CodePeer mode.
188 GNATprove_Mode
:= False;
189 Debug_Flag_Dot_FF
:= False;
191 -- Turn off inlining, confuses CodePeer output and gains nothing
193 Front_End_Inlining
:= False;
194 Inline_Active
:= False;
196 -- Disable front-end optimizations, to keep the tree as close to the
197 -- source code as possible, and also to avoid inconsistencies between
198 -- trees when using different optimization switches.
200 Optimization_Level
:= 0;
202 -- Enable some restrictions systematically to simplify the generated
203 -- code (and ease analysis). Note that restriction checks are also
204 -- disabled in CodePeer mode, see Restrict.Check_Restriction, and
205 -- user specified Restrictions pragmas are ignored, see
206 -- Sem_Prag.Process_Restrictions_Or_Restriction_Warnings.
208 Restrict
.Restrictions
.Set
(No_Initialize_Scalars
) := True;
209 Restrict
.Restrictions
.Set
(No_Task_Hierarchy
) := True;
210 Restrict
.Restrictions
.Set
(No_Abort_Statements
) := True;
211 Restrict
.Restrictions
.Set
(Max_Asynchronous_Select_Nesting
) := True;
212 Restrict
.Restrictions
.Value
(Max_Asynchronous_Select_Nesting
) := 0;
214 -- Suppress division by zero and access checks since they are handled
215 -- implicitly by CodePeer.
217 -- Turn off dynamic elaboration checks: generates inconsistencies in
218 -- trees between specs compiled as part of a main unit or as part of
221 -- Turn off alignment checks: these cannot be proved statically by
222 -- CodePeer and generate false positives.
224 -- Enable all other language checks
226 Suppress_Options
.Suppress
:=
227 (Access_Check
=> True,
228 Alignment_Check
=> True,
229 Division_Check
=> True,
230 Elaboration_Check
=> True,
233 Dynamic_Elaboration_Checks
:= False;
235 -- Set STRICT mode for overflow checks if not set explicitly. This
236 -- prevents suppressing of overflow checks by default, in code down
239 if Suppress_Options
.Overflow_Mode_General
= Not_Set
then
240 Suppress_Options
.Overflow_Mode_General
:= Strict
;
241 Suppress_Options
.Overflow_Mode_Assertions
:= Strict
;
244 -- CodePeer handles division and overflow checks directly, based on
245 -- the marks set by the frontend, hence no special expansion should
246 -- be performed in the frontend for division and overflow checks.
248 Backend_Divide_Checks_On_Target
:= True;
249 Backend_Overflow_Checks_On_Target
:= True;
251 -- Kill debug of generated code, since it messes up sloc values
253 Debug_Generated_Code
:= False;
255 -- Turn cross-referencing on in case it was disabled (e.g. by -gnatD)
256 -- Do we really need to spend time generating xref in CodePeer
257 -- mode??? Consider setting Xref_Active to False.
261 -- Polling mode forced off, since it generates confusing junk
263 Polling_Required
:= False;
265 -- Set operating mode to Generate_Code to benefit from full front-end
266 -- expansion (e.g. generics).
268 Operating_Mode
:= Generate_Code
;
270 -- We need SCIL generation of course
272 Generate_SCIL
:= True;
274 -- Enable assertions, since they give CodePeer valuable extra info
276 Assertions_Enabled
:= True;
278 -- Disable all simple value propagation. This is an optimization
279 -- which is valuable for code optimization, and also for generation
280 -- of compiler warnings, but these are being turned off by default,
281 -- and CodePeer generates better messages (referencing original
282 -- variables) this way.
284 Debug_Flag_MM
:= True;
286 -- Set normal RM validity checking, and checking of IN OUT parameters
287 -- (this might give CodePeer more useful checks to analyze, to be
288 -- confirmed???). All other validity checking is turned off, since
289 -- this can generate very complex trees that only confuse CodePeer
290 -- and do not bring enough useful info.
292 Reset_Validity_Check_Options
;
293 Validity_Check_Default
:= True;
294 Validity_Check_In_Out_Params
:= True;
295 Validity_Check_In_Params
:= True;
297 -- Turn off style check options and ignore any style check pragmas
298 -- since we are not interested in any front-end warnings when we are
299 -- getting CodePeer output.
301 Reset_Style_Check_Options
;
302 Ignore_Style_Checks_Pragmas
:= True;
304 -- Always perform semantics and generate ali files in CodePeer mode,
305 -- so that a gnatmake -c -k will proceed further when possible.
307 Force_ALI_Tree_File
:= True;
308 Try_Semantics
:= True;
310 -- Make the Ada front-end more liberal so that the compiler will
311 -- allow illegal code that is allowed by other compilers. CodePeer
312 -- is in the business of finding problems, not enforcing rules.
313 -- This is useful when using CodePeer mode with other compilers.
315 Relaxed_RM_Semantics
:= True;
318 -- Enable some individual switches that are implied by relaxed RM
321 if Relaxed_RM_Semantics
then
322 Opt
.Allow_Integer_Address
:= True;
323 Overriding_Renamings
:= True;
324 Treat_Categorization_Errors_As_Warnings
:= True;
327 -- Enable GNATprove_Mode when using -gnatd.F switch
329 if Debug_Flag_Dot_FF
then
330 GNATprove_Mode
:= True;
333 -- GNATprove_Mode is also activated by default in the gnat2why
336 if GNATprove_Mode
then
338 -- Turn off inlining, which would confuse formal verification output
341 Front_End_Inlining
:= False;
342 Inline_Active
:= False;
344 -- Issue warnings for failure to inline subprograms, as otherwise
345 -- expected in GNATprove mode for the local subprograms without
348 Ineffective_Inline_Warnings
:= True;
350 -- Disable front-end optimizations, to keep the tree as close to the
351 -- source code as possible, and also to avoid inconsistencies between
352 -- trees when using different optimization switches.
354 Optimization_Level
:= 0;
356 -- Enable some restrictions systematically to simplify the generated
357 -- code (and ease analysis). Note that restriction checks are also
358 -- disabled in SPARK mode, see Restrict.Check_Restriction, and user
359 -- specified Restrictions pragmas are ignored, see
360 -- Sem_Prag.Process_Restrictions_Or_Restriction_Warnings.
362 Restrict
.Restrictions
.Set
(No_Initialize_Scalars
) := True;
364 -- Note: at this point we used to suppress various checks, but that
365 -- is not what we want. We need the semantic processing for these
366 -- checks (which will set flags like Do_Overflow_Check, showing the
367 -- points at which potential checks are required semantically). We
368 -- don't want the expansion associated with these checks, but that
369 -- happens anyway because this expansion is simply not done in the
370 -- SPARK version of the expander.
372 -- On the contrary, we need to enable explicitly all language checks,
373 -- as they may have been suppressed by the use of switch -gnatp.
375 Suppress_Options
.Suppress
:= (others => False);
377 -- Turn off dynamic elaboration checks. SPARK mode depends on the
378 -- use of the static elaboration mode.
380 Dynamic_Elaboration_Checks
:= False;
382 -- Detect overflow on unconstrained floating-point types, such as
383 -- the predefined types Float, Long_Float and Long_Long_Float from
384 -- package Standard. Not necessary if float overflows are checked
385 -- (Machine_Overflow true), since appropriate Do_Overflow_Check flags
386 -- will be set in any case.
388 Check_Float_Overflow
:= not Machine_Overflows_On_Target
;
390 -- Set STRICT mode for overflow checks if not set explicitly. This
391 -- prevents suppressing of overflow checks by default, in code down
394 if Suppress_Options
.Overflow_Mode_General
= Not_Set
then
395 Suppress_Options
.Overflow_Mode_General
:= Strict
;
396 Suppress_Options
.Overflow_Mode_Assertions
:= Strict
;
399 -- Kill debug of generated code, since it messes up sloc values
401 Debug_Generated_Code
:= False;
403 -- Turn cross-referencing on in case it was disabled (e.g. by -gnatD)
404 -- as it is needed for computing effects of subprograms in the formal
405 -- verification backend.
409 -- Polling mode forced off, since it generates confusing junk
411 Polling_Required
:= False;
413 -- Set operating mode to Check_Semantics, but a light front-end
414 -- expansion is still performed.
416 Operating_Mode
:= Check_Semantics
;
418 -- Enable assertions, since they give valuable extra information for
419 -- formal verification.
421 Assertions_Enabled
:= True;
423 -- Disable validity checks, since it generates code raising
424 -- exceptions for invalid data, which confuses GNATprove. Invalid
425 -- data is directly detected by GNATprove's flow analysis.
427 Validity_Checks_On
:= False;
429 -- Turn off style check options since we are not interested in any
430 -- front-end warnings when we are getting SPARK output.
432 Reset_Style_Check_Options
;
434 -- Suppress the generation of name tables for enumerations, which are
435 -- not needed for formal verification, and fall outside the SPARK
436 -- subset (use of pointers).
438 Global_Discard_Names
:= True;
440 -- Suppress the expansion of tagged types and dispatching calls,
441 -- which lead to the generation of non-SPARK code (use of pointers),
442 -- which is more complex to formally verify than the original source.
444 Tagged_Type_Expansion
:= False;
447 -- Set Configurable_Run_Time mode if system.ads flag set or if the
448 -- special debug flag -gnatdY is set.
450 if Targparm
.Configurable_Run_Time_On_Target
or Debug_Flag_YY
then
451 Configurable_Run_Time_Mode
:= True;
454 -- Set -gnatR3m mode if debug flag A set
456 if Debug_Flag_AA
then
457 Back_Annotate_Rep_Info
:= True;
458 List_Representation_Info
:= 1;
459 List_Representation_Info_Mechanisms
:= True;
462 -- Force Target_Strict_Alignment true if debug flag -gnatd.a is set
464 if Debug_Flag_Dot_A
then
465 Ttypes
.Target_Strict_Alignment
:= True;
468 -- Increase size of allocated entities if debug flag -gnatd.N is set
470 if Debug_Flag_Dot_NN
then
471 Atree
.Num_Extension_Nodes
:= Atree
.Num_Extension_Nodes
+ 1;
474 -- Disable static allocation of dispatch tables if -gnatd.t or if layout
475 -- is enabled. The front end's layout phase currently treats types that
476 -- have discriminant-dependent arrays as not being static even when a
477 -- discriminant constraint on the type is static, and this leads to
478 -- problems with subtypes of type Ada.Tags.Dispatch_Table_Wrapper. ???
480 if Debug_Flag_Dot_T
or else Frontend_Layout_On_Target
then
481 Static_Dispatch_Tables
:= False;
484 -- Flip endian mode if -gnatd8 set
487 Ttypes
.Bytes_Big_Endian
:= not Ttypes
.Bytes_Big_Endian
;
490 -- Activate front end layout if debug flag -gnatdF is set
492 if Debug_Flag_FF
then
493 Targparm
.Frontend_Layout_On_Target
:= True;
496 -- Set and check exception mechanism
498 if Targparm
.ZCX_By_Default_On_Target
then
499 Exception_Mechanism
:= Back_End_Exceptions
;
502 -- Set proper status for overflow check mechanism
504 -- If already set (by -gnato or above in SPARK or CodePeer mode) then we
505 -- have nothing to do.
507 if Opt
.Suppress_Options
.Overflow_Mode_General
/= Not_Set
then
510 -- Otherwise set overflow mode defaults
513 -- Overflow checks are on by default (Suppress set False) except in
514 -- GNAT_Mode, where we want them off by default (we are not ready to
515 -- enable overflow checks in the compiler yet, for one thing the case
516 -- of 64-bit checks needs System.Arith_64 which is not a compiler
517 -- unit and it is a pain to try to include it in the compiler.
519 Suppress_Options
.Suppress
(Overflow_Check
) := GNAT_Mode
;
521 -- Set appropriate default overflow handling mode. Note: at present
522 -- we set STRICT in all three of the following cases. They are
523 -- separated because in the future we may make different choices.
525 -- By default set STRICT mode if -gnatg in effect
528 Suppress_Options
.Overflow_Mode_General
:= Strict
;
529 Suppress_Options
.Overflow_Mode_Assertions
:= Strict
;
531 -- If we have backend divide and overflow checks, then by default
532 -- overflow checks are STRICT. Historically this code used to also
533 -- activate overflow checks, although no target currently has these
534 -- flags set, so this was dead code anyway.
536 elsif Targparm
.Backend_Divide_Checks_On_Target
538 Targparm
.Backend_Overflow_Checks_On_Target
540 Suppress_Options
.Overflow_Mode_General
:= Strict
;
541 Suppress_Options
.Overflow_Mode_Assertions
:= Strict
;
543 -- Otherwise for now, default is STRICT mode. This may change in the
544 -- future, but for now this is the compatible behavior with previous
548 Suppress_Options
.Overflow_Mode_General
:= Strict
;
549 Suppress_Options
.Overflow_Mode_Assertions
:= Strict
;
553 -- Set default for atomic synchronization. As this synchronization
554 -- between atomic accesses can be expensive, and not typically needed
555 -- on some targets, an optional target parameter can turn the option
556 -- off. Note Atomic Synchronization is implemented as check.
558 Suppress_Options
.Suppress
(Atomic_Synchronization
) :=
559 not Atomic_Sync_Default_On_Target
;
561 -- Set switch indicating if back end can handle limited types, and
562 -- guarantee that no incorrect copies are made (e.g. in the context
563 -- of an if or case expression).
565 -- Debug flag -gnatd.L decisively sets usage on
567 if Debug_Flag_Dot_LL
then
568 Back_End_Handles_Limited_Types
:= True;
570 -- If no debug flag, usage off for AAMP, VM, SCIL cases
573 or else VM_Target
/= No_VM
574 or else Generate_SCIL
576 Back_End_Handles_Limited_Types
:= False;
578 -- Otherwise normal gcc back end, for now still turn flag off by
579 -- default, since there are unresolved problems in the front end.
582 Back_End_Handles_Limited_Types
:= False;
585 -- If the inlining level has not been set by the user, compute it from
586 -- the optimization level: 1 at -O1/-O2 (and -Os), 2 at -O3 and above.
588 if Inline_Level
= 0 then
589 if Optimization_Level
< 3 then
596 -- Treat -gnatn as equivalent to -gnatN for non-GCC targets
598 if Inline_Active
and not Front_End_Inlining
then
600 -- We really should have a tag for this, what if we added a new
601 -- back end some day, it would not be true for this test, but it
602 -- would be non-GCC, so this is a bit troublesome ???
604 Front_End_Inlining
:= VM_Target
/= No_VM
or else AAMP_On_Target
;
607 -- Set back end inlining indication
611 -- No back end inlining if inlining is suppressed
613 not Suppress_All_Inlining
615 -- No back end inlining available for VM targets
617 and then VM_Target
= No_VM
619 -- No back end inlining available on AAMP
621 and then not AAMP_On_Target
623 -- No back end inlining in GNATprove mode, since it just confuses
624 -- the formal verification process.
626 and then not GNATprove_Mode
628 -- No back end inlining if front end inlining explicitly enabled.
629 -- Done to minimize the output differences to customers still using
630 -- this deprecated switch; in addition, this behavior reduces the
631 -- output differences in old tests.
633 and then not Front_End_Inlining
635 -- Back end inlining is disabled if debug flag .z is set
637 and then not Debug_Flag_Dot_Z
;
639 -- Output warning if -gnateE specified and cannot be supported
641 if Exception_Extra_Info
642 and then Restrict
.No_Exception_Handlers_Set
646 ("warning: extra exception information (-gnateE) was specified");
649 ("warning: this capability is not available in this configuration");
654 -- Finally capture adjusted value of Suppress_Options as the initial
655 -- value for Scope_Suppress, which will be modified as we move from
656 -- scope to scope (by Suppress/Unsuppress/Overflow_Checks pragmas).
658 Sem
.Scope_Suppress
:= Opt
.Suppress_Options
;
659 end Adjust_Global_Switches
;
665 procedure Check_Bad_Body
is
666 Sname
: Unit_Name_Type
;
667 Src_Ind
: Source_File_Index
;
668 Fname
: File_Name_Type
;
670 procedure Bad_Body_Error
(Msg
: String);
671 -- Issue message for bad body found
677 procedure Bad_Body_Error
(Msg
: String) is
679 Error_Msg_N
(Msg
, Main_Unit_Node
);
680 Error_Msg_File_1
:= Fname
;
681 Error_Msg_N
("remove incorrect body in file{!", Main_Unit_Node
);
684 -- Start of processing for Check_Bad_Body
687 -- Nothing to do if we are only checking syntax, because we don't know
688 -- enough to know if we require or forbid a body in this case.
690 if Operating_Mode
= Check_Syntax
then
694 -- Check for body not allowed
696 if (Main_Kind
= N_Package_Declaration
697 and then not Body_Required
(Main_Unit_Node
))
698 or else (Main_Kind
= N_Generic_Package_Declaration
699 and then not Body_Required
(Main_Unit_Node
))
700 or else Main_Kind
= N_Package_Renaming_Declaration
701 or else Main_Kind
= N_Subprogram_Renaming_Declaration
702 or else Nkind
(Original_Node
(Unit
(Main_Unit_Node
)))
703 in N_Generic_Instantiation
705 Sname
:= Unit_Name
(Main_Unit
);
707 -- If we do not already have a body name, then get the body name
709 if not Is_Body_Name
(Sname
) then
710 Sname
:= Get_Body_Name
(Sname
);
713 Fname
:= Get_File_Name
(Sname
, Subunit
=> False);
714 Src_Ind
:= Load_Source_File
(Fname
);
716 -- Case where body is present and it is not a subunit. Exclude the
717 -- subunit case, because it has nothing to do with the package we are
718 -- compiling. It is illegal for a child unit and a subunit with the
719 -- same expanded name (RM 10.2(9)) to appear together in a partition,
720 -- but there is nothing to stop a compilation environment from having
721 -- both, and the test here simply allows that. If there is an attempt
722 -- to include both in a partition, this is diagnosed at bind time. In
723 -- Ada 83 mode this is not a warning case.
725 -- Note that in general we do not give the message if the file in
726 -- question does not look like a body. This includes weird cases,
727 -- but in particular means that if the file is just a No_Body pragma,
728 -- then we won't give the message (that's the whole point of this
729 -- pragma, to be used this way and to cause the body file to be
730 -- ignored in this context).
732 if Src_Ind
/= No_Source_File
733 and then Source_File_Is_Body
(Src_Ind
)
735 Errout
.Finalize
(Last_Call
=> False);
737 Error_Msg_Unit_1
:= Sname
;
739 -- Ada 83 case of a package body being ignored. This is not an
740 -- error as far as the Ada 83 RM is concerned, but it is almost
741 -- certainly not what is wanted so output a warning. Give this
742 -- message only if there were no errors, since otherwise it may
743 -- be incorrect (we may have misinterpreted a junk spec as not
744 -- needing a body when it really does).
746 if Main_Kind
= N_Package_Declaration
747 and then Ada_Version
= Ada_83
748 and then Operating_Mode
= Generate_Code
749 and then Distribution_Stub_Mode
/= Generate_Caller_Stub_Body
750 and then not Compilation_Errors
753 ("package $$ does not require a body??", Main_Unit_Node
);
754 Error_Msg_File_1
:= Fname
;
755 Error_Msg_N
("body in file{ will be ignored??", Main_Unit_Node
);
757 -- Ada 95 cases of a body file present when no body is
758 -- permitted. This we consider to be an error.
761 -- For generic instantiations, we never allow a body
763 if Nkind
(Original_Node
(Unit
(Main_Unit_Node
))) in
764 N_Generic_Instantiation
767 ("generic instantiation for $$ does not allow a body");
769 -- A library unit that is a renaming never allows a body
771 elsif Main_Kind
in N_Renaming_Declaration
then
773 ("renaming declaration for $$ does not allow a body!");
775 -- Remaining cases are packages and generic packages. Here
776 -- we only do the test if there are no previous errors,
777 -- because if there are errors, they may lead us to
778 -- incorrectly believe that a package does not allow a
779 -- body when in fact it does.
781 elsif not Compilation_Errors
then
782 if Main_Kind
= N_Package_Declaration
then
784 ("package $$ does not allow a body!");
786 elsif Main_Kind
= N_Generic_Package_Declaration
then
788 ("generic package $$ does not allow a body!");
801 procedure Check_Rep_Info
is
803 if List_Representation_Info
/= 0
804 or else List_Representation_Info_Mechanisms
809 ("cannot generate representation information, no code generated");
816 ----------------------------------------
817 -- Post_Compilation_Validation_Checks --
818 ----------------------------------------
820 procedure Post_Compilation_Validation_Checks
is
822 -- Validate alignment check warnings. In some cases we generate warnings
823 -- about possible alignment errors because we don't know the alignment
824 -- that will be chosen by the back end. This routine is in charge of
825 -- getting rid of those warnings if we can tell they are not needed.
827 Checks
.Validate_Alignment_Check_Warnings
;
829 -- Validate unchecked conversions (using the values for size and
830 -- alignment annotated by the backend where possible).
832 Sem_Ch13
.Validate_Unchecked_Conversions
;
834 -- Validate address clauses (again using alignment values annotated
835 -- by the backend where possible).
837 Sem_Ch13
.Validate_Address_Clauses
;
839 -- Validate independence pragmas (again using values annotated by
840 -- the back end for component layout etc.)
842 Sem_Ch13
.Validate_Independence
;
843 end Post_Compilation_Validation_Checks
;
845 -- Start of processing for Gnat1drv
848 -- This inner block is set up to catch assertion errors and constraint
849 -- errors. Since the code for handling these errors can cause another
850 -- exception to be raised (namely Unrecoverable_Error), we need two
851 -- nested blocks, so that the outer one handles unrecoverable error.
854 -- Initialize all packages. For the most part, these initialization
855 -- calls can be made in any order. Exceptions are as follows:
857 -- Lib.Initialize need to be called before Scan_Compiler_Arguments,
858 -- because it initializes a table filled by Scan_Compiler_Arguments.
864 Scan_Compiler_Arguments
;
865 Osint
.Add_Default_Search_Dirs
;
886 Sem_Type
.Init_Interp_Tables
;
888 -- Capture compilation date and time
890 Opt
.Compilation_Time
:= System
.OS_Lib
.Current_Time_String
;
892 -- Get the target parameters only when -gnats is not used, to avoid
893 -- failing when there is no default runtime.
895 if Operating_Mode
/= Check_Syntax
then
897 -- Acquire target parameters from system.ads (package System source)
899 Targparm_Acquire
: declare
902 S
: Source_File_Index
;
906 Name_Buffer
(1 .. 10) := "system.ads";
909 S
:= Load_Source_File
(N
);
911 -- Failed to read system.ads, fatal error
913 if S
= No_Source_File
then
915 ("fatal error, run-time library not installed correctly");
916 Write_Line
("cannot locate file system.ads");
917 raise Unrecoverable_Error
;
919 -- Read system.ads successfully, remember its source index
922 System_Source_File_Index
:= S
;
925 Targparm
.Get_Target_Parameters
926 (System_Text
=> Source_Text
(S
),
927 Source_First
=> Source_First
(S
),
928 Source_Last
=> Source_Last
(S
),
929 Make_Id
=> Tbuild
.Make_Id
'Access,
930 Make_SC
=> Tbuild
.Make_SC
'Access,
931 Set_RND
=> Tbuild
.Set_RND
'Access);
933 -- Acquire configuration pragma information from Targparm
935 Restrict
.Restrictions
:= Targparm
.Restrictions_On_Target
;
936 end Targparm_Acquire
;
939 -- Perform various adjustments and settings of global switches
941 Adjust_Global_Switches
;
943 -- Output copyright notice if full list mode unless we have a list
944 -- file, in which case we defer this so that it is output in the file.
946 if (Verbose_Mode
or else (Full_List
and then Full_List_File_Name
= null))
948 -- Debug flag gnatd7 suppresses this copyright notice
950 and then not Debug_Flag_7
954 Write_Str
(Gnat_Version_String
);
956 Write_Str
("Copyright 1992-" & Current_Year
957 & ", Free Software Foundation, Inc.");
961 -- Check we do not have more than one source file, this happens only in
962 -- the case where the driver is called directly, it cannot happen when
963 -- gnat1 is invoked from gcc in the normal case.
965 if Osint
.Number_Of_Files
/= 1 then
968 Osint
.Fail
("you must provide one source file");
970 elsif Usage_Requested
then
974 -- Generate target dependent output file if requested
976 if Target_Dependent_Info_Write_Name
/= null then
977 Set_Targ
.Write_Target_Dependent_Values
;
980 -- Call the front end
982 Original_Operating_Mode
:= Operating_Mode
;
985 -- Exit with errors if the main source could not be parsed.
987 if Sinput
.Main_Source_File
= No_Source_File
then
988 Errout
.Finalize
(Last_Call
=> True);
989 Errout
.Output_Messages
;
990 Exit_Program
(E_Errors
);
993 Main_Unit_Node
:= Cunit
(Main_Unit
);
994 Main_Kind
:= Nkind
(Unit
(Main_Unit_Node
));
997 -- In CodePeer mode we always delete old SCIL files before regenerating
998 -- new ones, in case of e.g. errors, and also to remove obsolete scilx
999 -- files generated by CodePeer itself.
1001 if CodePeer_Mode
then
1002 Comperr
.Delete_SCIL_Files
;
1005 -- Exit if compilation errors detected
1007 Errout
.Finalize
(Last_Call
=> False);
1009 if Compilation_Errors
then
1011 Post_Compilation_Validation_Checks
;
1012 Errout
.Output_Messages
;
1015 -- Generate ALI file if specially requested
1017 if Opt
.Force_ALI_Tree_File
then
1018 Write_ALI
(Object
=> False);
1022 Errout
.Finalize
(Last_Call
=> True);
1023 Exit_Program
(E_Errors
);
1026 -- Set Generate_Code on main unit and its spec. We do this even if are
1027 -- not generating code, since Lib-Writ uses this to determine which
1028 -- units get written in the ali file.
1030 Set_Generate_Code
(Main_Unit
);
1032 -- If we have a corresponding spec, and it comes from source or it is
1033 -- not a generated spec for a child subprogram body, then we need object
1034 -- code for the spec unit as well.
1036 if Nkind
(Unit
(Main_Unit_Node
)) in N_Unit_Body
1037 and then not Acts_As_Spec
(Main_Unit_Node
)
1039 if Nkind
(Unit
(Main_Unit_Node
)) = N_Subprogram_Body
1040 and then not Comes_From_Source
(Library_Unit
(Main_Unit_Node
))
1045 (Get_Cunit_Unit_Number
(Library_Unit
(Main_Unit_Node
)));
1049 -- Case of no code required to be generated, exit indicating no error
1051 if Original_Operating_Mode
= Check_Syntax
then
1053 Errout
.Finalize
(Last_Call
=> True);
1054 Errout
.Output_Messages
;
1059 -- Use a goto instead of calling Exit_Program so that finalization
1062 goto End_Of_Program
;
1064 elsif Original_Operating_Mode
= Check_Semantics
then
1065 Back_End_Mode
:= Declarations_Only
;
1067 -- All remaining cases are cases in which the user requested that code
1068 -- be generated (i.e. no -gnatc or -gnats switch was used). Check if we
1069 -- can in fact satisfy this request.
1071 -- Cannot generate code if someone has turned off code generation for
1072 -- any reason at all. We will try to figure out a reason below.
1074 elsif Operating_Mode
/= Generate_Code
then
1075 Back_End_Mode
:= Skip
;
1077 -- We can generate code for a subprogram body unless there were missing
1078 -- subunits. Note that we always generate code for all generic units (a
1079 -- change from some previous versions of GNAT).
1081 elsif Main_Kind
= N_Subprogram_Body
and then not Subunits_Missing
then
1082 Back_End_Mode
:= Generate_Object
;
1084 -- We can generate code for a package body unless there are subunits
1085 -- missing (note that we always generate code for generic units, which
1086 -- is a change from some earlier versions of GNAT).
1088 elsif Main_Kind
= N_Package_Body
and then not Subunits_Missing
then
1089 Back_End_Mode
:= Generate_Object
;
1091 -- We can generate code for a package declaration or a subprogram
1092 -- declaration only if it does not required a body.
1094 elsif Nkind_In
(Main_Kind
,
1095 N_Package_Declaration
,
1096 N_Subprogram_Declaration
)
1098 (not Body_Required
(Main_Unit_Node
)
1100 Distribution_Stub_Mode
= Generate_Caller_Stub_Body
)
1102 Back_End_Mode
:= Generate_Object
;
1104 -- We can generate code for a generic package declaration of a generic
1105 -- subprogram declaration only if does not require a body.
1107 elsif Nkind_In
(Main_Kind
, N_Generic_Package_Declaration
,
1108 N_Generic_Subprogram_Declaration
)
1109 and then not Body_Required
(Main_Unit_Node
)
1111 Back_End_Mode
:= Generate_Object
;
1113 -- Compilation units that are renamings do not require bodies, so we can
1114 -- generate code for them.
1116 elsif Nkind_In
(Main_Kind
, N_Package_Renaming_Declaration
,
1117 N_Subprogram_Renaming_Declaration
)
1119 Back_End_Mode
:= Generate_Object
;
1121 -- Compilation units that are generic renamings do not require bodies
1122 -- so we can generate code for them.
1124 elsif Main_Kind
in N_Generic_Renaming_Declaration
then
1125 Back_End_Mode
:= Generate_Object
;
1127 -- It is not an error to analyze in CodePeer mode a spec which requires
1128 -- a body, in order to generate SCIL for this spec.
1130 elsif CodePeer_Mode
then
1131 Back_End_Mode
:= Generate_Object
;
1133 -- It is not an error to analyze in GNATprove mode a spec which requires
1134 -- a body, when the body is not available. During frame condition
1135 -- generation, the corresponding ALI file is generated. During
1136 -- analysis, the spec is analyzed.
1138 elsif GNATprove_Mode
then
1139 Back_End_Mode
:= Declarations_Only
;
1141 -- In all other cases (specs which have bodies, generics, and bodies
1142 -- where subunits are missing), we cannot generate code and we generate
1143 -- a warning message. Note that generic instantiations are gone at this
1144 -- stage since they have been replaced by their instances.
1147 Back_End_Mode
:= Skip
;
1150 -- At this stage Back_End_Mode is set to indicate if the backend should
1151 -- be called to generate code. If it is Skip, then code generation has
1152 -- been turned off, even though code was requested by the original
1153 -- command. This is not an error from the user point of view, but it is
1154 -- an error from the point of view of the gcc driver, so we must exit
1155 -- with an error status.
1157 -- We generate an informative message (from the gcc point of view, it
1158 -- is an error message, but from the users point of view this is not an
1159 -- error, just a consequence of compiling something that cannot
1162 if Back_End_Mode
= Skip
then
1164 Write_Str
("cannot generate code for ");
1165 Write_Str
("file ");
1166 Write_Name
(Unit_File_Name
(Main_Unit
));
1168 if Subunits_Missing
then
1169 Write_Str
(" (missing subunits)");
1172 -- Force generation of ALI file, for backward compatibility
1174 Opt
.Force_ALI_Tree_File
:= True;
1176 elsif Main_Kind
= N_Subunit
then
1177 Write_Str
(" (subunit)");
1180 -- Force generation of ALI file, for backward compatibility
1182 Opt
.Force_ALI_Tree_File
:= True;
1184 elsif Main_Kind
= N_Subprogram_Declaration
then
1185 Write_Str
(" (subprogram spec)");
1188 -- Generic package body in GNAT implementation mode
1190 elsif Main_Kind
= N_Package_Body
and then GNAT_Mode
then
1191 Write_Str
(" (predefined generic)");
1194 -- Force generation of ALI file, for backward compatibility
1196 Opt
.Force_ALI_Tree_File
:= True;
1198 -- Only other case is a package spec
1201 Write_Str
(" (package spec)");
1205 Set_Standard_Output
;
1207 Post_Compilation_Validation_Checks
;
1208 Errout
.Finalize
(Last_Call
=> True);
1209 Errout
.Output_Messages
;
1213 -- Generate ALI file if specially requested, or for missing subunits,
1214 -- subunits or predefined generic.
1216 if Opt
.Force_ALI_Tree_File
then
1217 Write_ALI
(Object
=> False);
1223 -- Exit program with error indication, to kill object file
1225 Exit_Program
(E_No_Code
);
1228 -- In -gnatc mode, we only do annotation if -gnatt or -gnatR is also set
1229 -- as indicated by Back_Annotate_Rep_Info being set to True.
1231 -- We don't call for annotations on a subunit, because to process those
1232 -- the back-end requires that the parent(s) be properly compiled.
1234 -- Annotation is suppressed for targets where front-end layout is
1235 -- enabled, because the front end determines representations.
1237 -- Annotation is also suppressed in the case of compiling for a VM,
1238 -- since representations are largely symbolic there.
1240 if Back_End_Mode
= Declarations_Only
1242 (not (Back_Annotate_Rep_Info
or Generate_SCIL
or GNATprove_Mode
)
1243 or else Main_Kind
= N_Subunit
1244 or else Targparm
.Frontend_Layout_On_Target
1245 or else Targparm
.VM_Target
/= No_VM
)
1247 Post_Compilation_Validation_Checks
;
1248 Errout
.Finalize
(Last_Call
=> True);
1249 Errout
.Output_Messages
;
1250 Write_ALI
(Object
=> False);
1258 -- Ensure that we properly register a dependency on system.ads, since
1259 -- even if we do not semantically depend on this, Targparm has read
1260 -- system parameters from the system.ads file.
1262 Lib
.Writ
.Ensure_System_Dependency
;
1264 -- Add dependencies, if any, on preprocessing data file and on
1265 -- preprocessing definition file(s).
1267 Prepcomp
.Add_Dependencies
;
1269 -- In gnatprove mode we're writing the ALI much earlier than usual
1270 -- as flow analysis needs the file present in order to append its
1271 -- own globals to it.
1273 if GNATprove_Mode
then
1275 -- Note: In GNATprove mode, an "object" file is always generated as
1276 -- the result of calling gnat1 or gnat2why, although this is not the
1277 -- same as the object file produced for compilation.
1279 Write_ALI
(Object
=> True);
1282 -- Some back ends (for instance Gigi) are known to rely on SCOs for code
1283 -- generation. Make sure they are available.
1285 if Generate_SCO
then
1286 Par_SCO
.SCO_Record_Filtered
;
1289 -- Back end needs to explicitly unlock tables it needs to touch
1302 -- Here we call the back end to generate the output code
1304 Generating_Code
:= True;
1305 Back_End
.Call_Back_End
(Back_End_Mode
);
1307 -- Once the backend is complete, we unlock the names table. This call
1308 -- allows a few extra entries, needed for example for the file name for
1309 -- the library file output.
1313 -- Generate the call-graph output of dispatching calls
1315 Exp_CG
.Generate_CG_Output
;
1317 -- Perform post compilation validation checks
1319 Post_Compilation_Validation_Checks
;
1321 -- Now we complete output of errors, rep info and the tree info. These
1322 -- are delayed till now, since it is perfectly possible for gigi to
1323 -- generate errors, modify the tree (in particular by setting flags
1324 -- indicating that elaboration is required, and also to back annotate
1325 -- representation information for List_Rep_Info.
1327 Errout
.Finalize
(Last_Call
=> True);
1328 Errout
.Output_Messages
;
1329 List_Rep_Info
(Ttypes
.Bytes_Big_Endian
);
1330 Inline
.List_Inlining_Info
;
1332 -- Only write the library if the backend did not generate any error
1333 -- messages. Otherwise signal errors to the driver program so that
1334 -- there will be no attempt to generate an object file.
1336 if Compilation_Errors
then
1338 Exit_Program
(E_Errors
);
1341 if not GNATprove_Mode
then
1342 Write_ALI
(Object
=> (Back_End_Mode
= Generate_Object
));
1345 if not Compilation_Errors
then
1347 -- In case of ada backends, we need to make sure that the generated
1348 -- object file has a timestamp greater than the ALI file. We do this
1349 -- to make gnatmake happy when checking the ALI and obj timestamps,
1350 -- where it expects the object file being written after the ali file.
1352 -- Gnatmake's assumption is true for gcc platforms where the gcc
1353 -- wrapper needs to call the assembler after calling gnat1, but is
1354 -- not true for ada backends, where the object files are created
1355 -- directly by gnat1 (so are created before the ali file).
1357 Back_End
.Gen_Or_Update_Object_File
;
1360 -- Generate ASIS tree after writing the ALI file, since in ASIS mode,
1361 -- Write_ALI may in fact result in further tree decoration from the
1362 -- original tree file. Note that we dump the tree just before generating
1363 -- it, so that the dump will exactly reflect what is written out.
1368 -- Finalize name table and we are all done
1373 -- Handle fatal internal compiler errors
1375 when Rtsfind
.RE_Not_Available
=>
1376 Comperr
.Compiler_Abort
("RE_Not_Available");
1378 when System
.Assertions
.Assert_Failure
=>
1379 Comperr
.Compiler_Abort
("Assert_Failure");
1381 when Constraint_Error
=>
1382 Comperr
.Compiler_Abort
("Constraint_Error");
1384 when Program_Error
=>
1385 Comperr
.Compiler_Abort
("Program_Error");
1387 when Storage_Error
=>
1389 -- Assume this is a bug. If it is real, the message will in any case
1390 -- say Storage_Error, giving a strong hint.
1392 Comperr
.Compiler_Abort
("Storage_Error");
1398 -- The outer exception handles an unrecoverable error
1401 when Unrecoverable_Error
=>
1402 Errout
.Finalize
(Last_Call
=> True);
1403 Errout
.Output_Messages
;
1406 Write_Str
("compilation abandoned");
1409 Set_Standard_Output
;
1412 Exit_Program
(E_Errors
);