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