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