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