1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2002 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Atree
; use Atree
;
28 with Back_End
; use Back_End
;
30 with Csets
; use Csets
;
31 with Debug
; use Debug
;
33 with Errout
; use Errout
;
34 with Fname
; use Fname
;
35 with Fname
.UF
; use Fname
.UF
;
37 with Gnatvsn
; use Gnatvsn
;
41 with Lib
.Writ
; use Lib
.Writ
;
42 with Namet
; use Namet
;
45 with Osint
; use Osint
;
46 with Output
; use Output
;
47 with Repinfo
; use Repinfo
;
48 with Restrict
; use Restrict
;
51 with Sinfo
; use Sinfo
;
52 with Sinput
.L
; use Sinput
.L
;
54 with Sprint
; use Sprint
;
58 with Treepr
; use Treepr
;
60 with Types
; use Types
;
62 with Uname
; use Uname
;
66 with System
.Assertions
;
69 Main_Unit_Node
: Node_Id
;
70 -- Compilation unit node for main unit
72 Main_Unit_Entity
: Node_Id
;
73 -- Compilation unit entity for main unit
75 Main_Kind
: Node_Kind
;
76 -- Kind of main compilation unit node.
78 Original_Operating_Mode
: Operating_Mode_Type
;
79 -- Save operating type specified by options
81 Back_End_Mode
: Back_End
.Back_End_Mode_Type
;
82 -- Record back end mode
85 -- This inner block is set up to catch assertion errors and constraint
86 -- errors. Since the code for handling these errors can cause another
87 -- exception to be raised (namely Unrecoverable_Error), we need two
88 -- nested blocks, so that the outer one handles unrecoverable error.
91 -- Lib.Initialize need to be called before Scan_Compiler_Arguments,
92 -- because it initialize a table that is filled by
93 -- Scan_Compiler_Arguments.
96 Scan_Compiler_Arguments
;
97 Osint
.Add_Default_Search_Dirs
;
111 -- Acquire target parameters and perform required setup
113 Targparm
.Get_Target_Parameters
;
115 if Targparm
.High_Integrity_Mode_On_Target
then
116 Set_No_Run_Time_Mode
;
119 -- Output copyright notice if full list mode
121 if (Verbose_Mode
or Full_List
)
122 and then (not Debug_Flag_7
)
127 if Targparm
.High_Integrity_Mode_On_Target
then
128 Write_Str
("Pro High Integrity ");
131 Write_Str
(Gnat_Version_String
);
133 Write_Str
("Copyright 1992-2002 Free Software Foundation, Inc.");
137 -- Before we do anything else, adjust certain global values for
138 -- debug switches which modify their normal natural settings.
141 Ttypes
.Bytes_Big_Endian
:= not Ttypes
.Bytes_Big_Endian
;
145 Targparm
.OpenVMS_On_Target
:= True;
146 Hostparm
.OpenVMS
:= True;
149 if Debug_Flag_FF
then
150 Targparm
.Frontend_Layout_On_Target
:= True;
153 -- We take the default exception mechanism into account
155 if Targparm
.ZCX_By_Default_On_Target
then
156 if Targparm
.GCC_ZCX_Support_On_Target
then
157 Exception_Mechanism
:= GCC_ZCX
;
159 Exception_Mechanism
:= Front_End_ZCX
;
163 -- We take the command line exception mechanism into account
165 if Opt
.Zero_Cost_Exceptions_Set
then
166 if Opt
.Zero_Cost_Exceptions_Val
= False then
167 Exception_Mechanism
:= Setjmp_Longjmp
;
169 elsif Targparm
.GCC_ZCX_Support_On_Target
then
170 Exception_Mechanism
:= GCC_ZCX
;
172 elsif Targparm
.Front_End_ZCX_Support_On_Target
173 or else Debug_Flag_XX
175 Exception_Mechanism
:= Front_End_ZCX
;
179 ("Zero Cost Exceptions not supported on this target");
183 -- Set proper status for overflow checks. We turn on overflow checks
184 -- if -gnatp was not specified, and either -gnato is set or the back
185 -- end takes care of overflow checks. Otherwise we suppress overflow
186 -- checks by default (since front end checks are expensive).
188 if not Opt
.Suppress_Checks
189 and then (Opt
.Enable_Overflow_Checks
191 (Targparm
.Backend_Divide_Checks_On_Target
193 Targparm
.Backend_Overflow_Checks_On_Target
))
195 Suppress_Options
.Overflow_Checks
:= False;
197 Suppress_Options
.Overflow_Checks
:= True;
200 -- Check we have exactly one source file, this happens only in
201 -- the case where the driver is called directly, it cannot happen
202 -- when gnat1 is invoked from gcc in the normal case.
204 if Osint
.Number_Of_Files
/= 1 then
207 Osint
.Fail
("you must provide one source file");
209 elsif Usage_Requested
then
213 Original_Operating_Mode
:= Operating_Mode
;
215 Main_Unit_Node
:= Cunit
(Main_Unit
);
216 Main_Unit_Entity
:= Cunit_Entity
(Main_Unit
);
217 Main_Kind
:= Nkind
(Unit
(Main_Unit_Node
));
219 -- Check for suspicious or incorrect body present if we are doing
220 -- semantic checking. We omit this check in syntax only mode, because
221 -- in that case we do not know if we need a body or not.
223 if Operating_Mode
/= Check_Syntax
225 ((Main_Kind
= N_Package_Declaration
226 and then not Body_Required
(Main_Unit_Node
))
227 or else (Main_Kind
= N_Generic_Package_Declaration
228 and then not Body_Required
(Main_Unit_Node
))
229 or else Main_Kind
= N_Package_Renaming_Declaration
230 or else Main_Kind
= N_Subprogram_Renaming_Declaration
231 or else Nkind
(Original_Node
(Unit
(Main_Unit_Node
)))
232 in N_Generic_Instantiation
)
235 Sname
: Unit_Name_Type
:= Unit_Name
(Main_Unit
);
236 Src_Ind
: Source_File_Index
;
237 Fname
: File_Name_Type
;
239 procedure Bad_Body
(Msg
: String);
240 -- Issue message for bad body found
242 procedure Bad_Body
(Msg
: String) is
244 Error_Msg_N
(Msg
, Main_Unit_Node
);
245 Error_Msg_Name_1
:= Fname
;
247 ("remove incorrect body in file{!", Main_Unit_Node
);
251 Sname
:= Unit_Name
(Main_Unit
);
253 -- If we do not already have a body name, then get the body
254 -- name (but how can we have a body name here ???)
256 if not Is_Body_Name
(Sname
) then
257 Sname
:= Get_Body_Name
(Sname
);
260 Fname
:= Get_File_Name
(Sname
, Subunit
=> False);
261 Src_Ind
:= Load_Source_File
(Fname
);
263 -- Case where body is present and it is not a subunit. Exclude
264 -- the subunit case, because it has nothing to do with the
265 -- package we are compiling. It is illegal for a child unit
266 -- and a subunit with the same expanded name (RM 10.2(9)) to
267 -- appear together in a partition, but there is nothing to
268 -- stop a compilation environment from having both, and the
269 -- test here simply allows that. If there is an attempt to
270 -- include both in a partition, this is diagnosed at bind time.
271 -- In Ada 83 mode this is not a warning case.
273 if Src_Ind
/= No_Source_File
274 and then not Source_File_Is_Subunit
(Src_Ind
)
276 Error_Msg_Name_1
:= Sname
;
278 -- Ada 83 case of a package body being ignored. This is not
279 -- an error as far as the Ada 83 RM is concerned, but it is
280 -- almost certainly not what is wanted so output a warning.
281 -- Give this message only if there were no errors, since
282 -- otherwise it may be incorrect (we may have misinterpreted
283 -- a junk spec as not needing a body when it really does).
285 if Main_Kind
= N_Package_Declaration
287 and then Operating_Mode
= Generate_Code
288 and then Distribution_Stub_Mode
/= Generate_Caller_Stub_Body
289 and then not Compilation_Errors
292 ("package % does not require a body?!", Main_Unit_Node
);
293 Error_Msg_Name_1
:= Fname
;
295 ("body in file{?! will be ignored", Main_Unit_Node
);
297 -- Ada 95 cases of a body file present when no body is
298 -- permitted. This we consider to be an error.
301 -- For generic instantiations, we never allow a body
303 if Nkind
(Original_Node
(Unit
(Main_Unit_Node
)))
304 in N_Generic_Instantiation
307 ("generic instantiation for % does not allow a body");
309 -- A library unit that is a renaming never allows a body
311 elsif Main_Kind
in N_Renaming_Declaration
then
313 ("renaming declaration for % does not allow a body!");
315 -- Remaining cases are packages and generic packages.
316 -- Here we only do the test if there are no previous
317 -- errors, because if there are errors, they may lead
318 -- us to incorrectly believe that a package does not
319 -- allow a body when in fact it does.
321 elsif not Compilation_Errors
then
322 if Main_Kind
= N_Package_Declaration
then
323 Bad_Body
("package % does not allow a body!");
325 elsif Main_Kind
= N_Generic_Package_Declaration
then
326 Bad_Body
("generic package % does not allow a body!");
335 -- Exit if compilation errors detected
337 if Compilation_Errors
then
339 Sem_Ch13
.Validate_Unchecked_Conversions
;
343 -- Generate ALI file if specially requested
345 if Opt
.Force_ALI_Tree_File
then
346 Write_ALI
(Object
=> False);
350 Exit_Program
(E_Errors
);
353 -- Set Generate_Code on main unit and its spec. We do this even if
354 -- are not generating code, since Lib-Writ uses this to determine
355 -- which units get written in the ali file.
357 Set_Generate_Code
(Main_Unit
);
359 -- If we have a corresponding spec, then we need object
360 -- code for the spec unit as well
362 if Nkind
(Unit
(Main_Unit_Node
)) in N_Unit_Body
363 and then not Acts_As_Spec
(Main_Unit_Node
)
366 (Get_Cunit_Unit_Number
(Library_Unit
(Main_Unit_Node
)));
369 -- Case of no code required to be generated, exit indicating no error
371 if Original_Operating_Mode
= Check_Syntax
then
376 Exit_Program
(E_Success
);
378 elsif Original_Operating_Mode
= Check_Semantics
then
379 Back_End_Mode
:= Declarations_Only
;
381 -- All remaining cases are cases in which the user requested that code
382 -- be generated (i.e. no -gnatc or -gnats switch was used). Check if
383 -- we can in fact satisfy this request.
385 -- Cannot generate code if someone has turned off code generation
386 -- for any reason at all. We will try to figure out a reason below.
388 elsif Operating_Mode
/= Generate_Code
then
389 Back_End_Mode
:= Skip
;
391 -- We can generate code for a subprogram body unless its corresponding
392 -- subprogram spec is a generic delaration. Note that the check for
393 -- No (Library_Unit) here is a defensive check that should not be
394 -- necessary, since the Library_Unit field should be set properly.
396 elsif Main_Kind
= N_Subprogram_Body
397 and then not Subunits_Missing
398 and then (No
(Library_Unit
(Main_Unit_Node
))
399 or else Nkind
(Unit
(Library_Unit
(Main_Unit_Node
))) /=
400 N_Generic_Subprogram_Declaration
401 or else Generic_Separately_Compiled
(Main_Unit_Entity
))
403 Back_End_Mode
:= Generate_Object
;
405 -- We can generate code for a package body unless its corresponding
406 -- package spec is a generic declaration. As described above, the
407 -- check for No (LIbrary_Unit) is a defensive check.
409 elsif Main_Kind
= N_Package_Body
410 and then not Subunits_Missing
411 and then (No
(Library_Unit
(Main_Unit_Node
))
412 or else Nkind
(Unit
(Library_Unit
(Main_Unit_Node
))) /=
413 N_Generic_Package_Declaration
414 or else Generic_Separately_Compiled
(Main_Unit_Entity
))
417 Back_End_Mode
:= Generate_Object
;
419 -- We can generate code for a package declaration or a subprogram
420 -- declaration only if it does not required a body.
422 elsif (Main_Kind
= N_Package_Declaration
424 Main_Kind
= N_Subprogram_Declaration
)
426 (not Body_Required
(Main_Unit_Node
)
428 Distribution_Stub_Mode
= Generate_Caller_Stub_Body
)
430 Back_End_Mode
:= Generate_Object
;
432 -- We can generate code for a generic package declaration of a generic
433 -- subprogram declaration only if does not require a body, and if it
434 -- is a generic that is separately compiled.
436 elsif (Main_Kind
= N_Generic_Package_Declaration
438 Main_Kind
= N_Generic_Subprogram_Declaration
)
439 and then not Body_Required
(Main_Unit_Node
)
440 and then Generic_Separately_Compiled
(Main_Unit_Entity
)
442 Back_End_Mode
:= Generate_Object
;
444 -- Compilation units that are renamings do not require bodies,
445 -- so we can generate code for them.
447 elsif Main_Kind
= N_Package_Renaming_Declaration
448 or else Main_Kind
= N_Subprogram_Renaming_Declaration
450 Back_End_Mode
:= Generate_Object
;
452 -- Compilation units that are generic renamings do not require bodies
453 -- so we can generate code for them in the separately compiled case
455 elsif Main_Kind
in N_Generic_Renaming_Declaration
456 and then Generic_Separately_Compiled
(Main_Unit_Entity
)
458 Back_End_Mode
:= Generate_Object
;
460 -- In all other cases (specs which have bodies, generics, and bodies
461 -- where subunits are missing), we cannot generate code and we generate
462 -- a warning message. Note that generic instantiations are gone at this
463 -- stage since they have been replaced by their instances.
466 Back_End_Mode
:= Skip
;
469 -- At this stage Call_Back_End is set to indicate if the backend
470 -- should be called to generate code. If it is not set, then code
471 -- generation has been turned off, even though code was requested
472 -- by the original command. This is not an error from the user
473 -- point of view, but it is an error from the point of view of
474 -- the gcc driver, so we must exit with an error status.
476 -- We generate an informative message (from the gcc point of view,
477 -- it is an error message, but from the users point of view this
478 -- is not an error, just a consequence of compiling something that
479 -- cannot generate code).
481 if Back_End_Mode
= Skip
then
482 Write_Str
("No code generated for ");
484 Write_Name
(Unit_File_Name
(Main_Unit
));
486 if Subunits_Missing
then
487 Write_Str
(" (missing subunits)");
489 elsif Main_Kind
= N_Subunit
then
490 Write_Str
(" (subunit)");
492 elsif Main_Kind
= N_Package_Body
493 or else Main_Kind
= N_Subprogram_Body
495 Write_Str
(" (generic unit)");
497 elsif Main_Kind
= N_Subprogram_Declaration
then
498 Write_Str
(" (subprogram spec)");
500 -- Only other case is a package spec
503 Write_Str
(" (package spec)");
508 Sem_Ch13
.Validate_Unchecked_Conversions
;
512 Write_ALI
(Object
=> False);
515 -- Exit program with error indication, to kill object file
517 Exit_Program
(E_No_Code
);
520 -- In -gnatc mode, we only do annotation if -gnatt or -gnatR is also
521 -- set as indicated by Back_Annotate_Rep_Info being set to True.
523 -- We don't call for annotations on a subunit, because to process those
524 -- the back-end requires that the parent(s) be properly compiled.
526 -- Annotation is also suppressed in the case of compiling for
527 -- the Java VM, since representations are largely symbolic there.
529 if Back_End_Mode
= Declarations_Only
530 and then (not (Back_Annotate_Rep_Info
or Debug_Flag_AA
)
531 or else Main_Kind
= N_Subunit
532 or else Hostparm
.Java_VM
)
534 Sem_Ch13
.Validate_Unchecked_Conversions
;
536 Write_ALI
(Object
=> False);
543 -- Ensure that we properly register a dependency on system.ads,
544 -- since even if we do not semantically depend on this, Targparm
545 -- has read system parameters from the system.ads file.
547 Lib
.Writ
.Ensure_System_Dependency
;
549 -- Back end needs to explicitly unlock tables it needs to touch
562 -- There are cases where the back end emits warnings, e.g. on objects
563 -- that are too large and will cause Storage_Error. If such a warning
564 -- appears in a generic context, then it is always appropriately
565 -- placed on the instance rather than the template, since gigi only
566 -- deals with generated code in instances (in particular the warning
567 -- for oversize objects clearly belongs on the instance).
569 Warn_On_Instance
:= True;
571 -- Here we call the backend to generate the output code
573 Back_End
.Call_Back_End
(Back_End_Mode
);
575 -- Once the backend is complete, we unlock the names table. This
576 -- call allows a few extra entries, needed for example for the file
577 -- name for the library file output.
581 -- Validate unchecked conversions (using the values for size
582 -- and alignment annotated by the backend where possible).
584 Sem_Ch13
.Validate_Unchecked_Conversions
;
586 -- Now we complete output of errors, rep info and the tree info.
587 -- These are delayed till now, since it is perfectly possible for
588 -- gigi to generate errors, modify the tree (in particular by setting
589 -- flags indicating that elaboration is required, and also to back
590 -- annotate representation information for List_Rep_Info.
594 if Opt
.List_Representation_Info
/= 0 or else Debug_Flag_AA
then
598 -- Only write the library if the backend did not generate any error
599 -- messages. Otherwise signal errors to the driver program so that
600 -- there will be no attempt to generate an object file.
602 if Compilation_Errors
then
604 Exit_Program
(E_Errors
);
607 Write_ALI
(Object
=> (Back_End_Mode
= Generate_Object
));
609 -- Generate the ASIS tree after writing the ALI file, since in
610 -- ASIS mode, Write_ALI may in fact result in further tree
611 -- decoration from the original tree file. Note that we dump
612 -- the tree just before generating it, so that the dump will
613 -- exactly reflect what is written out.
618 -- Finalize name table and we are all done
623 -- Handle fatal internal compiler errors
625 when System
.Assertions
.Assert_Failure
=>
626 Comperr
.Compiler_Abort
("Assert_Failure");
628 when Constraint_Error
=>
629 Comperr
.Compiler_Abort
("Constraint_Error");
631 when Program_Error
=>
632 Comperr
.Compiler_Abort
("Program_Error");
634 when Storage_Error
=>
636 -- Assume this is a bug. If it is real, the message will in
637 -- any case say Storage_Error, giving a strong hint!
639 Comperr
.Compiler_Abort
("Storage_Error");
642 -- The outer exception handles an unrecoverable error
645 when Unrecoverable_Error
=>
649 Write_Str
("compilation abandoned");
655 Exit_Program
(E_Errors
);