]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- G N A T 1 D R V -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
07fc65c4 | 9 | -- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- |
38cbfe40 RK |
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 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. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
38cbfe40 RK |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
27 | with Atree; use Atree; | |
28 | with Back_End; use Back_End; | |
29 | with Comperr; | |
30 | with Csets; use Csets; | |
31 | with Debug; use Debug; | |
32 | with Elists; | |
33 | with Errout; use Errout; | |
34 | with Fname; use Fname; | |
35 | with Fname.UF; use Fname.UF; | |
36 | with Frontend; | |
37 | with Gnatvsn; use Gnatvsn; | |
38 | with Hostparm; | |
39 | with Inline; | |
40 | with Lib; use Lib; | |
41 | with Lib.Writ; use Lib.Writ; | |
42 | with Namet; use Namet; | |
43 | with Nlists; | |
44 | with Opt; use Opt; | |
45 | with Osint; use Osint; | |
46 | with Output; use Output; | |
47 | with Repinfo; use Repinfo; | |
48 | with Restrict; use Restrict; | |
49 | with Sem; | |
50 | with Sem_Ch13; | |
38cbfe40 RK |
51 | with Sinfo; use Sinfo; |
52 | with Sinput.L; use Sinput.L; | |
53 | with Snames; | |
54 | with Sprint; use Sprint; | |
55 | with Stringt; | |
56 | with Targparm; | |
57 | with Tree_Gen; | |
58 | with Treepr; use Treepr; | |
59 | with Ttypes; | |
60 | with Types; use Types; | |
61 | with Uintp; | |
62 | with Uname; use Uname; | |
63 | with Urealp; | |
64 | with Usage; | |
65 | ||
66 | with System.Assertions; | |
67 | ||
68 | procedure Gnat1drv is | |
69 | Main_Unit_Node : Node_Id; | |
70 | -- Compilation unit node for main unit | |
71 | ||
72 | Main_Unit_Entity : Node_Id; | |
73 | -- Compilation unit entity for main unit | |
74 | ||
75 | Main_Kind : Node_Kind; | |
76 | -- Kind of main compilation unit node. | |
77 | ||
78 | Original_Operating_Mode : Operating_Mode_Type; | |
79 | -- Save operating type specified by options | |
80 | ||
81 | Back_End_Mode : Back_End.Back_End_Mode_Type; | |
82 | -- Record back end mode | |
83 | ||
84 | begin | |
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. | |
89 | ||
90 | begin | |
07fc65c4 GB |
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. | |
94 | ||
95 | Lib.Initialize; | |
38cbfe40 RK |
96 | Scan_Compiler_Arguments; |
97 | Osint.Add_Default_Search_Dirs; | |
98 | ||
99 | Sinput.Initialize; | |
38cbfe40 RK |
100 | Sem.Initialize; |
101 | Csets.Initialize; | |
102 | Uintp.Initialize; | |
103 | Urealp.Initialize; | |
104 | Errout.Initialize; | |
105 | Namet.Initialize; | |
106 | Snames.Initialize; | |
107 | Stringt.Initialize; | |
108 | Inline.Initialize; | |
109 | Sem_Ch13.Initialize; | |
110 | ||
07fc65c4 GB |
111 | -- Acquire target parameters and perform required setup |
112 | ||
113 | Targparm.Get_Target_Parameters; | |
114 | ||
115 | if Targparm.High_Integrity_Mode_On_Target then | |
116 | Set_No_Run_Time_Mode; | |
117 | end if; | |
118 | ||
38cbfe40 RK |
119 | -- Output copyright notice if full list mode |
120 | ||
121 | if (Verbose_Mode or Full_List) | |
122 | and then (not Debug_Flag_7) | |
123 | then | |
124 | Write_Eol; | |
125 | Write_Str ("GNAT "); | |
38cbfe40 | 126 | |
07fc65c4 GB |
127 | if Targparm.High_Integrity_Mode_On_Target then |
128 | Write_Str ("Pro High Integrity "); | |
129 | end if; | |
38cbfe40 | 130 | |
07fc65c4 | 131 | Write_Str (Gnat_Version_String); |
b4f94ac1 ZW |
132 | Write_Eol; |
133 | Write_Str ("Copyright 1992-2002 Free Software Foundation, Inc."); | |
07fc65c4 | 134 | Write_Eol; |
38cbfe40 RK |
135 | end if; |
136 | ||
137 | -- Before we do anything else, adjust certain global values for | |
138 | -- debug switches which modify their normal natural settings. | |
139 | ||
140 | if Debug_Flag_8 then | |
141 | Ttypes.Bytes_Big_Endian := not Ttypes.Bytes_Big_Endian; | |
142 | end if; | |
143 | ||
144 | if Debug_Flag_M then | |
145 | Targparm.OpenVMS_On_Target := True; | |
146 | Hostparm.OpenVMS := True; | |
147 | end if; | |
148 | ||
149 | if Debug_Flag_FF then | |
150 | Targparm.Frontend_Layout_On_Target := True; | |
151 | end if; | |
152 | ||
153 | -- We take the default exception mechanism into account | |
154 | ||
155 | if Targparm.ZCX_By_Default_On_Target then | |
156 | if Targparm.GCC_ZCX_Support_On_Target then | |
157 | Exception_Mechanism := GCC_ZCX; | |
158 | else | |
159 | Exception_Mechanism := Front_End_ZCX; | |
160 | end if; | |
161 | end if; | |
162 | ||
163 | -- We take the command line exception mechanism into account | |
164 | ||
165 | if Opt.Zero_Cost_Exceptions_Set then | |
166 | if Opt.Zero_Cost_Exceptions_Val = False then | |
167 | Exception_Mechanism := Setjmp_Longjmp; | |
168 | ||
169 | elsif Targparm.GCC_ZCX_Support_On_Target then | |
170 | Exception_Mechanism := GCC_ZCX; | |
171 | ||
172 | elsif Targparm.Front_End_ZCX_Support_On_Target | |
173 | or else Debug_Flag_XX | |
174 | then | |
175 | Exception_Mechanism := Front_End_ZCX; | |
176 | ||
177 | else | |
178 | Osint.Fail | |
179 | ("Zero Cost Exceptions not supported on this target"); | |
180 | end if; | |
181 | end if; | |
182 | ||
07fc65c4 GB |
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). | |
187 | ||
188 | if not Opt.Suppress_Checks | |
189 | and then (Opt.Enable_Overflow_Checks | |
190 | or else | |
191 | (Targparm.Backend_Divide_Checks_On_Target | |
192 | and | |
193 | Targparm.Backend_Overflow_Checks_On_Target)) | |
194 | then | |
195 | Suppress_Options.Overflow_Checks := False; | |
196 | else | |
197 | Suppress_Options.Overflow_Checks := True; | |
198 | end if; | |
199 | ||
38cbfe40 RK |
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. | |
203 | ||
204 | if Osint.Number_Of_Files /= 1 then | |
205 | Usage; | |
206 | Write_Eol; | |
207 | Osint.Fail ("you must provide one source file"); | |
208 | ||
209 | elsif Usage_Requested then | |
210 | Usage; | |
211 | end if; | |
212 | ||
213 | Original_Operating_Mode := Operating_Mode; | |
214 | Frontend; | |
215 | Main_Unit_Node := Cunit (Main_Unit); | |
216 | Main_Unit_Entity := Cunit_Entity (Main_Unit); | |
217 | Main_Kind := Nkind (Unit (Main_Unit_Node)); | |
218 | ||
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. | |
222 | ||
223 | if Operating_Mode /= Check_Syntax | |
224 | and then | |
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) | |
233 | then | |
234 | declare | |
235 | Sname : Unit_Name_Type := Unit_Name (Main_Unit); | |
236 | Src_Ind : Source_File_Index; | |
237 | Fname : File_Name_Type; | |
238 | ||
239 | procedure Bad_Body (Msg : String); | |
240 | -- Issue message for bad body found | |
241 | ||
242 | procedure Bad_Body (Msg : String) is | |
243 | begin | |
244 | Error_Msg_N (Msg, Main_Unit_Node); | |
245 | Error_Msg_Name_1 := Fname; | |
246 | Error_Msg_N | |
247 | ("remove incorrect body in file{!", Main_Unit_Node); | |
248 | end Bad_Body; | |
249 | ||
250 | begin | |
251 | Sname := Unit_Name (Main_Unit); | |
252 | ||
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 ???) | |
255 | ||
256 | if not Is_Body_Name (Sname) then | |
257 | Sname := Get_Body_Name (Sname); | |
258 | end if; | |
259 | ||
260 | Fname := Get_File_Name (Sname, Subunit => False); | |
261 | Src_Ind := Load_Source_File (Fname); | |
262 | ||
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. | |
272 | ||
273 | if Src_Ind /= No_Source_File | |
274 | and then not Source_File_Is_Subunit (Src_Ind) | |
275 | then | |
276 | Error_Msg_Name_1 := Sname; | |
277 | ||
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). | |
284 | ||
285 | if Main_Kind = N_Package_Declaration | |
286 | and then Ada_83 | |
287 | and then Operating_Mode = Generate_Code | |
288 | and then Distribution_Stub_Mode /= Generate_Caller_Stub_Body | |
289 | and then not Compilation_Errors | |
290 | then | |
291 | Error_Msg_N | |
292 | ("package % does not require a body?!", Main_Unit_Node); | |
293 | Error_Msg_Name_1 := Fname; | |
294 | Error_Msg_N | |
295 | ("body in file{?! will be ignored", Main_Unit_Node); | |
296 | ||
297 | -- Ada 95 cases of a body file present when no body is | |
298 | -- permitted. This we consider to be an error. | |
299 | ||
300 | else | |
301 | -- For generic instantiations, we never allow a body | |
302 | ||
303 | if Nkind (Original_Node (Unit (Main_Unit_Node))) | |
304 | in N_Generic_Instantiation | |
305 | then | |
306 | Bad_Body | |
307 | ("generic instantiation for % does not allow a body"); | |
308 | ||
309 | -- A library unit that is a renaming never allows a body | |
310 | ||
311 | elsif Main_Kind in N_Renaming_Declaration then | |
312 | Bad_Body | |
313 | ("renaming declaration for % does not allow a body!"); | |
314 | ||
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. | |
320 | ||
321 | elsif not Compilation_Errors then | |
322 | if Main_Kind = N_Package_Declaration then | |
323 | Bad_Body ("package % does not allow a body!"); | |
324 | ||
325 | elsif Main_Kind = N_Generic_Package_Declaration then | |
326 | Bad_Body ("generic package % does not allow a body!"); | |
327 | end if; | |
328 | end if; | |
329 | ||
330 | end if; | |
331 | end if; | |
332 | end; | |
333 | end if; | |
334 | ||
335 | -- Exit if compilation errors detected | |
336 | ||
337 | if Compilation_Errors then | |
338 | Treepr.Tree_Dump; | |
339 | Sem_Ch13.Validate_Unchecked_Conversions; | |
340 | Errout.Finalize; | |
341 | Namet.Finalize; | |
342 | ||
343 | -- Generate ALI file if specially requested | |
344 | ||
345 | if Opt.Force_ALI_Tree_File then | |
346 | Write_ALI (Object => False); | |
347 | Tree_Gen; | |
348 | end if; | |
349 | ||
350 | Exit_Program (E_Errors); | |
351 | end if; | |
352 | ||
38cbfe40 RK |
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. | |
356 | ||
357 | Set_Generate_Code (Main_Unit); | |
358 | ||
359 | -- If we have a corresponding spec, then we need object | |
360 | -- code for the spec unit as well | |
361 | ||
362 | if Nkind (Unit (Main_Unit_Node)) in N_Unit_Body | |
363 | and then not Acts_As_Spec (Main_Unit_Node) | |
364 | then | |
365 | Set_Generate_Code | |
366 | (Get_Cunit_Unit_Number (Library_Unit (Main_Unit_Node))); | |
367 | end if; | |
368 | ||
38cbfe40 RK |
369 | -- Case of no code required to be generated, exit indicating no error |
370 | ||
371 | if Original_Operating_Mode = Check_Syntax then | |
372 | Treepr.Tree_Dump; | |
373 | Errout.Finalize; | |
374 | Tree_Gen; | |
375 | Namet.Finalize; | |
376 | Exit_Program (E_Success); | |
377 | ||
378 | elsif Original_Operating_Mode = Check_Semantics then | |
379 | Back_End_Mode := Declarations_Only; | |
380 | ||
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. | |
384 | ||
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. | |
387 | ||
388 | elsif Operating_Mode /= Generate_Code then | |
389 | Back_End_Mode := Skip; | |
390 | ||
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. | |
395 | ||
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)) | |
402 | then | |
403 | Back_End_Mode := Generate_Object; | |
404 | ||
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. | |
408 | ||
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)) | |
415 | ||
416 | then | |
417 | Back_End_Mode := Generate_Object; | |
418 | ||
419 | -- We can generate code for a package declaration or a subprogram | |
420 | -- declaration only if it does not required a body. | |
421 | ||
422 | elsif (Main_Kind = N_Package_Declaration | |
423 | or else | |
424 | Main_Kind = N_Subprogram_Declaration) | |
425 | and then | |
426 | (not Body_Required (Main_Unit_Node) | |
427 | or else | |
428 | Distribution_Stub_Mode = Generate_Caller_Stub_Body) | |
429 | then | |
430 | Back_End_Mode := Generate_Object; | |
431 | ||
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. | |
435 | ||
436 | elsif (Main_Kind = N_Generic_Package_Declaration | |
437 | or else | |
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) | |
441 | then | |
442 | Back_End_Mode := Generate_Object; | |
443 | ||
444 | -- Compilation units that are renamings do not require bodies, | |
445 | -- so we can generate code for them. | |
446 | ||
447 | elsif Main_Kind = N_Package_Renaming_Declaration | |
448 | or else Main_Kind = N_Subprogram_Renaming_Declaration | |
449 | then | |
450 | Back_End_Mode := Generate_Object; | |
451 | ||
452 | -- Compilation units that are generic renamings do not require bodies | |
453 | -- so we can generate code for them in the separately compiled case | |
454 | ||
455 | elsif Main_Kind in N_Generic_Renaming_Declaration | |
456 | and then Generic_Separately_Compiled (Main_Unit_Entity) | |
457 | then | |
458 | Back_End_Mode := Generate_Object; | |
459 | ||
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. | |
464 | ||
465 | else | |
466 | Back_End_Mode := Skip; | |
467 | end if; | |
468 | ||
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. | |
475 | ||
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). | |
480 | ||
481 | if Back_End_Mode = Skip then | |
482 | Write_Str ("No code generated for "); | |
483 | Write_Str ("file "); | |
484 | Write_Name (Unit_File_Name (Main_Unit)); | |
485 | ||
486 | if Subunits_Missing then | |
487 | Write_Str (" (missing subunits)"); | |
488 | ||
489 | elsif Main_Kind = N_Subunit then | |
490 | Write_Str (" (subunit)"); | |
491 | ||
492 | elsif Main_Kind = N_Package_Body | |
493 | or else Main_Kind = N_Subprogram_Body | |
494 | then | |
495 | Write_Str (" (generic unit)"); | |
496 | ||
497 | elsif Main_Kind = N_Subprogram_Declaration then | |
498 | Write_Str (" (subprogram spec)"); | |
499 | ||
500 | -- Only other case is a package spec | |
501 | ||
502 | else | |
503 | Write_Str (" (package spec)"); | |
504 | end if; | |
505 | ||
506 | Write_Eol; | |
507 | ||
508 | Sem_Ch13.Validate_Unchecked_Conversions; | |
509 | Errout.Finalize; | |
510 | Treepr.Tree_Dump; | |
511 | Tree_Gen; | |
512 | Write_ALI (Object => False); | |
513 | Namet.Finalize; | |
514 | ||
515 | -- Exit program with error indication, to kill object file | |
516 | ||
517 | Exit_Program (E_No_Code); | |
518 | end if; | |
519 | ||
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. | |
522 | ||
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. | |
525 | ||
526 | -- Annotation is also suppressed in the case of compiling for | |
527 | -- the Java VM, since representations are largely symbolic there. | |
528 | ||
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) | |
533 | then | |
534 | Sem_Ch13.Validate_Unchecked_Conversions; | |
535 | Errout.Finalize; | |
536 | Write_ALI (Object => False); | |
537 | Tree_Dump; | |
538 | Tree_Gen; | |
539 | Namet.Finalize; | |
540 | return; | |
541 | end if; | |
542 | ||
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. | |
546 | ||
547 | Lib.Writ.Ensure_System_Dependency; | |
548 | ||
549 | -- Back end needs to explicitly unlock tables it needs to touch | |
550 | ||
551 | Atree.Lock; | |
552 | Elists.Lock; | |
553 | Fname.UF.Lock; | |
554 | Inline.Lock; | |
555 | Lib.Lock; | |
556 | Nlists.Lock; | |
557 | Sem.Lock; | |
558 | Sinput.Lock; | |
559 | Namet.Lock; | |
560 | Stringt.Lock; | |
561 | ||
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). | |
568 | ||
569 | Warn_On_Instance := True; | |
570 | ||
571 | -- Here we call the backend to generate the output code | |
572 | ||
573 | Back_End.Call_Back_End (Back_End_Mode); | |
574 | ||
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. | |
578 | ||
579 | Namet.Unlock; | |
580 | ||
581 | -- Validate unchecked conversions (using the values for size | |
582 | -- and alignment annotated by the backend where possible). | |
583 | ||
584 | Sem_Ch13.Validate_Unchecked_Conversions; | |
585 | ||
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. | |
591 | ||
592 | Errout.Finalize; | |
593 | ||
594 | if Opt.List_Representation_Info /= 0 or else Debug_Flag_AA then | |
595 | List_Rep_Info; | |
596 | end if; | |
597 | ||
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. | |
601 | ||
602 | if Compilation_Errors then | |
603 | Treepr.Tree_Dump; | |
604 | Exit_Program (E_Errors); | |
605 | end if; | |
606 | ||
607 | Write_ALI (Object => (Back_End_Mode = Generate_Object)); | |
608 | ||
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. | |
614 | ||
615 | Treepr.Tree_Dump; | |
616 | Tree_Gen; | |
617 | ||
618 | -- Finalize name table and we are all done | |
619 | ||
620 | Namet.Finalize; | |
621 | ||
622 | exception | |
623 | -- Handle fatal internal compiler errors | |
624 | ||
625 | when System.Assertions.Assert_Failure => | |
626 | Comperr.Compiler_Abort ("Assert_Failure"); | |
627 | ||
628 | when Constraint_Error => | |
629 | Comperr.Compiler_Abort ("Constraint_Error"); | |
630 | ||
631 | when Program_Error => | |
632 | Comperr.Compiler_Abort ("Program_Error"); | |
633 | ||
634 | when Storage_Error => | |
635 | ||
636 | -- Assume this is a bug. If it is real, the message will in | |
637 | -- any case say Storage_Error, giving a strong hint! | |
638 | ||
639 | Comperr.Compiler_Abort ("Storage_Error"); | |
640 | end; | |
641 | ||
642 | -- The outer exception handles an unrecoverable error | |
643 | ||
644 | exception | |
645 | when Unrecoverable_Error => | |
646 | Errout.Finalize; | |
647 | ||
648 | Set_Standard_Error; | |
649 | Write_Str ("compilation abandoned"); | |
650 | Write_Eol; | |
651 | ||
652 | Set_Standard_Output; | |
653 | Source_Dump; | |
654 | Tree_Dump; | |
655 | Exit_Program (E_Errors); | |
656 | ||
657 | end Gnat1drv; |