1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 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
;
35 with Fname
; use Fname
;
36 with Fname
.UF
; use Fname
.UF
;
38 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
;
50 with Repinfo
; use Repinfo
;
60 with Sinfo
; use Sinfo
;
61 with Sinput
.L
; use Sinput
.L
;
63 with Sprint
; use Sprint
;
67 with Treepr
; use Treepr
;
69 with Types
; use Types
;
70 with Uintp
; use Uintp
;
71 with Uname
; use Uname
;
75 with System
.Assertions
;
78 Main_Unit_Node
: Node_Id
;
79 -- Compilation unit node for main unit
81 Main_Unit_Entity
: Node_Id
;
82 -- Compilation unit entity for main unit
84 Main_Kind
: Node_Kind
;
85 -- Kind of main compilation unit node.
87 Back_End_Mode
: Back_End
.Back_End_Mode_Type
;
88 -- Record back end mode
91 -- This inner block is set up to catch assertion errors and constraint
92 -- errors. Since the code for handling these errors can cause another
93 -- exception to be raised (namely Unrecoverable_Error), we need two
94 -- nested blocks, so that the outer one handles unrecoverable error.
97 -- Lib.Initialize need to be called before Scan_Compiler_Arguments,
98 -- because it initialize a table that is filled by
99 -- Scan_Compiler_Arguments.
105 Scan_Compiler_Arguments
;
106 Osint
.Add_Default_Search_Dirs
;
124 Sem_Type
.Init_Interp_Tables
;
126 -- Acquire target parameters from system.ads (source of package System)
131 S
: Source_File_Index
;
133 R
: Restrict
.Restriction_Id
;
134 P
: Restrict
.Restriction_Parameter_Id
;
137 Name_Buffer
(1 .. 10) := "system.ads";
140 S
:= Load_Source_File
(N
);
142 if S
= No_Source_File
then
144 ("fatal error, run-time library not installed correctly");
146 ("cannot locate file system.ads");
147 raise Unrecoverable_Error
;
149 -- Here if system.ads successfully read. Remember its source index.
152 System_Source_File_Index
:= S
;
155 Targparm
.Get_Target_Parameters
156 (System_Text
=> Source_Text
(S
),
157 Source_First
=> Source_First
(S
),
158 Source_Last
=> Source_Last
(S
));
160 -- Acquire configuration pragma information from Targparm
162 for J
in Rident
.Partition_Restrictions
loop
163 R
:= Restrict
.Partition_Restrictions
(J
);
165 if Targparm
.Restrictions_On_Target
(J
) then
166 Restrict
.Restrictions
(R
) := True;
167 Restrict
.Restrictions_Loc
(R
) := System_Location
;
171 for K
in Rident
.Restriction_Parameter_Id
loop
172 P
:= Restrict
.Restriction_Parameter_Id
(K
);
174 if Targparm
.Restriction_Parameters_On_Target
(K
) /= No_Uint
then
175 Restrict
.Restriction_Parameters
(P
) :=
176 Targparm
.Restriction_Parameters_On_Target
(K
);
177 Restrict
.Restriction_Parameters_Loc
(P
) := System_Location
;
182 -- Set Configurable_Run_Time mode if system.ads flag set
184 if Targparm
.Configurable_Run_Time_On_Target
or Debug_Flag_YY
then
185 Configurable_Run_Time_Mode
:= True;
188 -- Output copyright notice if full list mode
190 if (Verbose_Mode
or Full_List
)
191 and then (not Debug_Flag_7
)
195 Write_Str
(Gnat_Version_String
);
196 Write_Str
(" Copyright 1992-2003 Free Software Foundation, Inc.");
200 -- Before we do anything else, adjust certain global values for
201 -- debug switches which modify their normal natural settings.
204 Ttypes
.Bytes_Big_Endian
:= not Ttypes
.Bytes_Big_Endian
;
208 Targparm
.OpenVMS_On_Target
:= True;
209 Hostparm
.OpenVMS
:= True;
212 if Debug_Flag_FF
then
213 Targparm
.Frontend_Layout_On_Target
:= True;
216 -- We take the default exception mechanism into account
218 if Targparm
.ZCX_By_Default_On_Target
then
219 if Targparm
.GCC_ZCX_Support_On_Target
then
220 Exception_Mechanism
:= Back_End_ZCX_Exceptions
;
222 Exception_Mechanism
:= Front_End_ZCX_Exceptions
;
226 -- We take the command line exception mechanism into account
228 if Opt
.Zero_Cost_Exceptions_Set
then
229 if Opt
.Zero_Cost_Exceptions_Val
= False then
230 Exception_Mechanism
:= Front_End_Setjmp_Longjmp_Exceptions
;
232 elsif Debug_Flag_XX
then
233 Exception_Mechanism
:= Front_End_ZCX_Exceptions
;
235 elsif Targparm
.GCC_ZCX_Support_On_Target
then
236 Exception_Mechanism
:= Back_End_ZCX_Exceptions
;
238 elsif Targparm
.Front_End_ZCX_Support_On_Target
then
239 Exception_Mechanism
:= Front_End_ZCX_Exceptions
;
243 ("Zero Cost Exceptions not supported on this target");
247 -- Set proper status for overflow checks. We turn on overflow checks
248 -- if -gnatp was not specified, and either -gnato is set or the back
249 -- end takes care of overflow checks. Otherwise we suppress overflow
250 -- checks by default (since front end checks are expensive).
252 if not Opt
.Suppress_Checks
253 and then (Opt
.Enable_Overflow_Checks
255 (Targparm
.Backend_Divide_Checks_On_Target
257 Targparm
.Backend_Overflow_Checks_On_Target
))
259 Suppress_Options
(Overflow_Check
) := False;
261 Suppress_Options
(Overflow_Check
) := True;
264 -- Check we have exactly one source file, this happens only in
265 -- the case where the driver is called directly, it cannot happen
266 -- when gnat1 is invoked from gcc in the normal case.
268 if Osint
.Number_Of_Files
/= 1 then
271 Osint
.Fail
("you must provide one source file");
273 elsif Usage_Requested
then
277 Original_Operating_Mode
:= Operating_Mode
;
279 Main_Unit_Node
:= Cunit
(Main_Unit
);
280 Main_Unit_Entity
:= Cunit_Entity
(Main_Unit
);
281 Main_Kind
:= Nkind
(Unit
(Main_Unit_Node
));
283 -- Check for suspicious or incorrect body present if we are doing
284 -- semantic checking. We omit this check in syntax only mode, because
285 -- in that case we do not know if we need a body or not.
287 if Operating_Mode
/= Check_Syntax
289 ((Main_Kind
= N_Package_Declaration
290 and then not Body_Required
(Main_Unit_Node
))
291 or else (Main_Kind
= N_Generic_Package_Declaration
292 and then not Body_Required
(Main_Unit_Node
))
293 or else Main_Kind
= N_Package_Renaming_Declaration
294 or else Main_Kind
= N_Subprogram_Renaming_Declaration
295 or else Nkind
(Original_Node
(Unit
(Main_Unit_Node
)))
296 in N_Generic_Instantiation
)
299 Sname
: Unit_Name_Type
:= Unit_Name
(Main_Unit
);
300 Src_Ind
: Source_File_Index
;
301 Fname
: File_Name_Type
;
303 procedure Bad_Body
(Msg
: String);
304 -- Issue message for bad body found
306 procedure Bad_Body
(Msg
: String) is
308 Error_Msg_N
(Msg
, Main_Unit_Node
);
309 Error_Msg_Name_1
:= Fname
;
311 ("remove incorrect body in file{!", Main_Unit_Node
);
315 Sname
:= Unit_Name
(Main_Unit
);
317 -- If we do not already have a body name, then get the body
318 -- name (but how can we have a body name here ???)
320 if not Is_Body_Name
(Sname
) then
321 Sname
:= Get_Body_Name
(Sname
);
324 Fname
:= Get_File_Name
(Sname
, Subunit
=> False);
325 Src_Ind
:= Load_Source_File
(Fname
);
327 -- Case where body is present and it is not a subunit. Exclude
328 -- the subunit case, because it has nothing to do with the
329 -- package we are compiling. It is illegal for a child unit
330 -- and a subunit with the same expanded name (RM 10.2(9)) to
331 -- appear together in a partition, but there is nothing to
332 -- stop a compilation environment from having both, and the
333 -- test here simply allows that. If there is an attempt to
334 -- include both in a partition, this is diagnosed at bind time.
335 -- In Ada 83 mode this is not a warning case.
337 if Src_Ind
/= No_Source_File
338 and then not Source_File_Is_Subunit
(Src_Ind
)
340 Error_Msg_Name_1
:= Sname
;
342 -- Ada 83 case of a package body being ignored. This is not
343 -- an error as far as the Ada 83 RM is concerned, but it is
344 -- almost certainly not what is wanted so output a warning.
345 -- Give this message only if there were no errors, since
346 -- otherwise it may be incorrect (we may have misinterpreted
347 -- a junk spec as not needing a body when it really does).
349 if Main_Kind
= N_Package_Declaration
351 and then Operating_Mode
= Generate_Code
352 and then Distribution_Stub_Mode
/= Generate_Caller_Stub_Body
353 and then not Compilation_Errors
356 ("package % does not require a body?!", Main_Unit_Node
);
357 Error_Msg_Name_1
:= Fname
;
359 ("body in file{?! will be ignored", Main_Unit_Node
);
361 -- Ada 95 cases of a body file present when no body is
362 -- permitted. This we consider to be an error.
365 -- For generic instantiations, we never allow a body
367 if Nkind
(Original_Node
(Unit
(Main_Unit_Node
)))
368 in N_Generic_Instantiation
371 ("generic instantiation for % does not allow a body");
373 -- A library unit that is a renaming never allows a body
375 elsif Main_Kind
in N_Renaming_Declaration
then
377 ("renaming declaration for % does not allow a body!");
379 -- Remaining cases are packages and generic packages.
380 -- Here we only do the test if there are no previous
381 -- errors, because if there are errors, they may lead
382 -- us to incorrectly believe that a package does not
383 -- allow a body when in fact it does.
385 elsif not Compilation_Errors
then
386 if Main_Kind
= N_Package_Declaration
then
387 Bad_Body
("package % does not allow a body!");
389 elsif Main_Kind
= N_Generic_Package_Declaration
then
390 Bad_Body
("generic package % does not allow a body!");
399 -- Exit if compilation errors detected
401 if Compilation_Errors
then
403 Sem_Ch13
.Validate_Unchecked_Conversions
;
407 -- Generate ALI file if specially requested
409 if Opt
.Force_ALI_Tree_File
then
410 Write_ALI
(Object
=> False);
414 Exit_Program
(E_Errors
);
417 -- Set Generate_Code on main unit and its spec. We do this even if
418 -- are not generating code, since Lib-Writ uses this to determine
419 -- which units get written in the ali file.
421 Set_Generate_Code
(Main_Unit
);
423 -- If we have a corresponding spec, then we need object
424 -- code for the spec unit as well
426 if Nkind
(Unit
(Main_Unit_Node
)) in N_Unit_Body
427 and then not Acts_As_Spec
(Main_Unit_Node
)
430 (Get_Cunit_Unit_Number
(Library_Unit
(Main_Unit_Node
)));
433 -- Case of no code required to be generated, exit indicating no error
435 if Original_Operating_Mode
= Check_Syntax
then
440 Exit_Program
(E_Success
);
442 elsif Original_Operating_Mode
= Check_Semantics
then
443 Back_End_Mode
:= Declarations_Only
;
445 -- All remaining cases are cases in which the user requested that code
446 -- be generated (i.e. no -gnatc or -gnats switch was used). Check if
447 -- we can in fact satisfy this request.
449 -- Cannot generate code if someone has turned off code generation
450 -- for any reason at all. We will try to figure out a reason below.
452 elsif Operating_Mode
/= Generate_Code
then
453 Back_End_Mode
:= Skip
;
455 -- We can generate code for a subprogram body unless there were
456 -- missing subunits. Note that we always generate code for all
457 -- generic units (a change from some previous versions of GNAT).
459 elsif Main_Kind
= N_Subprogram_Body
460 and then not Subunits_Missing
462 Back_End_Mode
:= Generate_Object
;
464 -- We can generate code for a package body unless there are subunits
465 -- missing (note that we always generate code for generic units, which
466 -- is a change from some earlier versions of GNAT).
468 elsif Main_Kind
= N_Package_Body
469 and then not Subunits_Missing
471 Back_End_Mode
:= Generate_Object
;
473 -- We can generate code for a package declaration or a subprogram
474 -- declaration only if it does not required a body.
476 elsif (Main_Kind
= N_Package_Declaration
478 Main_Kind
= N_Subprogram_Declaration
)
480 (not Body_Required
(Main_Unit_Node
)
482 Distribution_Stub_Mode
= Generate_Caller_Stub_Body
)
484 Back_End_Mode
:= Generate_Object
;
486 -- We can generate code for a generic package declaration of a generic
487 -- subprogram declaration only if does not require a body.
489 elsif (Main_Kind
= N_Generic_Package_Declaration
491 Main_Kind
= N_Generic_Subprogram_Declaration
)
492 and then not Body_Required
(Main_Unit_Node
)
494 Back_End_Mode
:= Generate_Object
;
496 -- Compilation units that are renamings do not require bodies,
497 -- so we can generate code for them.
499 elsif Main_Kind
= N_Package_Renaming_Declaration
500 or else Main_Kind
= N_Subprogram_Renaming_Declaration
502 Back_End_Mode
:= Generate_Object
;
504 -- Compilation units that are generic renamings do not require bodies
505 -- so we can generate code for them.
507 elsif Main_Kind
in N_Generic_Renaming_Declaration
then
508 Back_End_Mode
:= Generate_Object
;
510 -- In all other cases (specs which have bodies, generics, and bodies
511 -- where subunits are missing), we cannot generate code and we generate
512 -- a warning message. Note that generic instantiations are gone at this
513 -- stage since they have been replaced by their instances.
516 Back_End_Mode
:= Skip
;
519 -- At this stage Call_Back_End is set to indicate if the backend
520 -- should be called to generate code. If it is not set, then code
521 -- generation has been turned off, even though code was requested
522 -- by the original command. This is not an error from the user
523 -- point of view, but it is an error from the point of view of
524 -- the gcc driver, so we must exit with an error status.
526 -- We generate an informative message (from the gcc point of view,
527 -- it is an error message, but from the users point of view this
528 -- is not an error, just a consequence of compiling something that
529 -- cannot generate code).
531 if Back_End_Mode
= Skip
then
532 Write_Str
("cannot generate code for ");
534 Write_Name
(Unit_File_Name
(Main_Unit
));
536 if Subunits_Missing
then
537 Write_Str
(" (missing subunits)");
539 Write_Str
("to check parent unit");
541 elsif Main_Kind
= N_Subunit
then
542 Write_Str
(" (subunit)");
544 Write_Str
("to check subunit");
546 elsif Main_Kind
= N_Subprogram_Declaration
then
547 Write_Str
(" (subprogram spec)");
549 Write_Str
("to check subprogram spec");
551 -- Generic package body in GNAT implementation mode
553 elsif Main_Kind
= N_Package_Body
and then GNAT_Mode
then
554 Write_Str
(" (predefined generic)");
556 Write_Str
("to check predefined generic");
558 -- Only other case is a package spec
561 Write_Str
(" (package spec)");
563 Write_Str
("to check package spec");
566 Write_Str
(" for errors, use ");
568 if Hostparm
.OpenVMS
then
569 Write_Str
("/NOLOAD");
571 Write_Str
("-gnatc");
576 Sem_Ch13
.Validate_Unchecked_Conversions
;
580 Write_ALI
(Object
=> False);
583 -- Exit program with error indication, to kill object file
585 Exit_Program
(E_No_Code
);
588 -- In -gnatc mode, we only do annotation if -gnatt or -gnatR is also
589 -- set as indicated by Back_Annotate_Rep_Info being set to True.
591 -- We don't call for annotations on a subunit, because to process those
592 -- the back-end requires that the parent(s) be properly compiled.
594 -- Annotation is also suppressed in the case of compiling for
595 -- the Java VM, since representations are largely symbolic there.
597 if Back_End_Mode
= Declarations_Only
598 and then (not (Back_Annotate_Rep_Info
or Debug_Flag_AA
)
599 or else Main_Kind
= N_Subunit
600 or else Hostparm
.Java_VM
)
602 Sem_Ch13
.Validate_Unchecked_Conversions
;
604 Write_ALI
(Object
=> False);
611 -- Ensure that we properly register a dependency on system.ads,
612 -- since even if we do not semantically depend on this, Targparm
613 -- has read system parameters from the system.ads file.
615 Lib
.Writ
.Ensure_System_Dependency
;
617 -- Add dependencies, if any, on preprocessing data file and on
618 -- preprocessing definition file(s).
620 Prepcomp
.Add_Dependencies
;
622 -- Back end needs to explicitly unlock tables it needs to touch
635 -- Here we call the back end to generate the output code
637 Back_End
.Call_Back_End
(Back_End_Mode
);
639 -- Once the backend is complete, we unlock the names table. This
640 -- call allows a few extra entries, needed for example for the file
641 -- name for the library file output.
645 -- Validate unchecked conversions (using the values for size
646 -- and alignment annotated by the backend where possible).
648 Sem_Ch13
.Validate_Unchecked_Conversions
;
650 -- Now we complete output of errors, rep info and the tree info.
651 -- These are delayed till now, since it is perfectly possible for
652 -- gigi to generate errors, modify the tree (in particular by setting
653 -- flags indicating that elaboration is required, and also to back
654 -- annotate representation information for List_Rep_Info.
659 -- Only write the library if the backend did not generate any error
660 -- messages. Otherwise signal errors to the driver program so that
661 -- there will be no attempt to generate an object file.
663 if Compilation_Errors
then
665 Exit_Program
(E_Errors
);
668 Write_ALI
(Object
=> (Back_End_Mode
= Generate_Object
));
670 -- Generate the ASIS tree after writing the ALI file, since in
671 -- ASIS mode, Write_ALI may in fact result in further tree
672 -- decoration from the original tree file. Note that we dump
673 -- the tree just before generating it, so that the dump will
674 -- exactly reflect what is written out.
679 -- Finalize name table and we are all done
684 -- Handle fatal internal compiler errors
686 when System
.Assertions
.Assert_Failure
=>
687 Comperr
.Compiler_Abort
("Assert_Failure");
689 when Constraint_Error
=>
690 Comperr
.Compiler_Abort
("Constraint_Error");
692 when Program_Error
=>
693 Comperr
.Compiler_Abort
("Program_Error");
695 when Storage_Error
=>
697 -- Assume this is a bug. If it is real, the message will in
698 -- any case say Storage_Error, giving a strong hint!
700 Comperr
.Compiler_Abort
("Storage_Error");
703 -- The outer exception handles an unrecoverable error
706 when Unrecoverable_Error
=>
710 Write_Str
("compilation abandoned");
716 Exit_Program
(E_Errors
);