gcc/ada/lib-load.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             L I B . L O A D                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2003 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 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Atree;    use Atree;
  28 with Debug;    use Debug;
  29 with Einfo;    use Einfo;
  30 with Errout;   use Errout;
  31 with Fname;    use Fname;
  32 with Fname.UF; use Fname.UF;
  33 with Namet;    use Namet;
  34 with Nlists;   use Nlists;
  35 with Nmake;    use Nmake;
  36 with Opt;      use Opt;
  37 with Osint;    use Osint;
  38 with Osint.C;  use Osint.C;
  39 with Output;   use Output;
  40 with Par;
  41 with Scn;      use Scn;
  42 with Sinfo;    use Sinfo;
  43 with Sinput;   use Sinput;
  44 with Sinput.L; use Sinput.L;
  45 with Stand;    use Stand;
  46 with Targparm; use Targparm;
  47 with Tbuild;   use Tbuild;
  48 with Uname;    use Uname;
  49
  50 package body Lib.Load is
  51
  52    -----------------------
  53    -- Local Subprograms --
  54    -----------------------
  55
  56    function Spec_Is_Irrelevant
  57      (Spec_Unit : Unit_Number_Type;
  58       Body_Unit : Unit_Number_Type)
  59       return      Boolean;
  60    --  The Spec_Unit and Body_Unit parameters are the unit numbers of the
  61    --  spec file that corresponds to the main unit which is a body. This
  62    --  function determines if the spec file is irrelevant and will be
  63    --  overridden by the body as described in RM 10.1.4(4). See description
  64    --  in "Special Handling of Subprogram Bodies" for further details.
  65
  66    procedure Write_Dependency_Chain;
  67    --  This procedure is used to generate error message info lines that
  68    --  trace the current dependency chain when a load error occurs.
  69
  70    -------------------------------
  71    -- Create_Dummy_Package_Unit --
  72    -------------------------------
  73
  74    function Create_Dummy_Package_Unit
  75      (With_Node : Node_Id;
  76       Spec_Name : Unit_Name_Type)
  77       return      Unit_Number_Type
  78    is
  79       Unum         : Unit_Number_Type;
  80       Cunit_Entity : Entity_Id;
  81       Cunit        : Node_Id;
  82       Du_Name      : Node_Or_Entity_Id;
  83       End_Lab      : Node_Id;
  84       Save_CS      : constant Boolean := Get_Comes_From_Source_Default;
  85
  86    begin
  87       --  The created dummy package unit does not come from source
  88
  89       Set_Comes_From_Source_Default (False);
  90
  91       --  Normal package
  92
  93       if Nkind (Name (With_Node)) = N_Identifier then
  94          Cunit_Entity :=
  95            Make_Defining_Identifier (No_Location,
  96              Chars => Chars (Name (With_Node)));
  97          Du_Name := Cunit_Entity;
  98          End_Lab := New_Occurrence_Of (Cunit_Entity, No_Location);
  99
 100       --  Child package
 101
 102       else
 103
 104          --  Nkind (Name (With_Node)) = N_Expanded_Name
 105
 106          Cunit_Entity :=
 107            Make_Defining_Identifier (No_Location,
 108              Chars => Chars (Selector_Name (Name (With_Node))));
 109          Du_Name :=
 110            Make_Defining_Program_Unit_Name (No_Location,
 111              Name => New_Copy_Tree (Prefix (Name (With_Node))),
 112              Defining_Identifier => Cunit_Entity);
 113
 114          Set_Is_Child_Unit (Cunit_Entity);
 115
 116          End_Lab :=
 117            Make_Designator (No_Location,
 118              Name => New_Copy_Tree (Prefix (Name (With_Node))),
 119              Identifier => New_Occurrence_Of (Cunit_Entity, No_Location));
 120
 121       end if;
 122
 123       Set_Scope (Cunit_Entity, Standard_Standard);
 124
 125       Cunit :=
 126         Make_Compilation_Unit (No_Location,
 127           Context_Items => Empty_List,
 128           Unit =>
 129             Make_Package_Declaration (No_Location,
 130               Specification =>
 131                 Make_Package_Specification (No_Location,
 132                   Defining_Unit_Name   => Du_Name,
 133                   Visible_Declarations => Empty_List,
 134                   End_Label            => End_Lab)),
 135           Aux_Decls_Node =>
 136             Make_Compilation_Unit_Aux (No_Location));
 137
 138       --  Mark the dummy package as analyzed to prevent analysis of this
 139       --  (non-existent) unit in -gnatQ mode because at the moment the
 140       --  structure and attributes of this dummy package does not allow
 141       --  a normal analysis of this unit
 142
 143       Set_Analyzed (Cunit);
 144
 145       Units.Increment_Last;
 146       Unum := Units.Last;
 147
 148       Units.Table (Unum) := (
 149         Cunit           => Cunit,
 150         Cunit_Entity    => Cunit_Entity,
 151         Dependency_Num  => 0,
 152         Dependent_Unit  => False,
 153         Dynamic_Elab    => False,
 154         Error_Location  => Sloc (With_Node),
 155         Expected_Unit   => Spec_Name,
 156         Fatal_Error     => True,
 157         Generate_Code   => False,
 158         Has_RACW        => False,
 159         Ident_String    => Empty,
 160         Loading         => False,
 161         Main_Priority   => Default_Main_Priority,
 162         Serial_Number   => 0,
 163         Source_Index    => No_Source_File,
 164         Unit_File_Name  => Get_File_Name (Spec_Name, Subunit => False),
 165         Unit_Name       => Spec_Name,
 166         Version         => 0);
 167
 168       Set_Comes_From_Source_Default (Save_CS);
 169       Set_Error_Posted (Cunit_Entity);
 170       Set_Error_Posted (Cunit);
 171       return Unum;
 172    end Create_Dummy_Package_Unit;
 173
 174    ----------------
 175    -- Initialize --
 176    ----------------
 177
 178    procedure Initialize is
 179    begin
 180       Units.Init;
 181       Load_Stack.Init;
 182    end Initialize;
 183
 184    ------------------------
 185    -- Initialize_Version --
 186    ------------------------
 187
 188    procedure Initialize_Version (U : Unit_Number_Type) is
 189    begin
 190       Units.Table (U).Version := Source_Checksum (Source_Index (U));
 191    end Initialize_Version;
 192
 193    ----------------------
 194    -- Load_Main_Source --
 195    ----------------------
 196
 197    procedure Load_Main_Source is
 198       Fname : File_Name_Type;
 199
 200    begin
 201       Load_Stack.Increment_Last;
 202       Load_Stack.Table (Load_Stack.Last) := Main_Unit;
 203
 204       --  Initialize unit table entry for Main_Unit. Note that we don't know
 205       --  the unit name yet, that gets filled in when the parser parses the
 206       --  main unit, at which time a check is made that it matches the main
 207       --  file name, and then the Unit_Name field is set. The Cunit and
 208       --  Cunit_Entity fields also get filled in later by the parser.
 209
 210       Units.Increment_Last;
 211       Fname := Next_Main_Source;
 212
 213       Units.Table (Main_Unit).Unit_File_Name := Fname;
 214
 215       if Fname /= No_File then
 216
 217          Main_Source_File := Load_Source_File (Fname);
 218          Current_Error_Source_File := Main_Source_File;
 219
 220          Units.Table (Main_Unit) := (
 221            Cunit           => Empty,
 222            Cunit_Entity    => Empty,
 223            Dependency_Num  => 0,
 224            Dependent_Unit  => True,
 225            Dynamic_Elab    => False,
 226            Error_Location  => No_Location,
 227            Expected_Unit   => No_Name,
 228            Fatal_Error     => False,
 229            Generate_Code   => False,
 230            Has_RACW        => False,
 231            Loading         => True,
 232            Ident_String    => Empty,
 233            Main_Priority   => Default_Main_Priority,
 234            Serial_Number   => 0,
 235            Source_Index    => Main_Source_File,
 236            Unit_File_Name  => Fname,
 237            Unit_Name       => No_Name,
 238            Version         => Source_Checksum (Main_Source_File));
 239       end if;
 240    end Load_Main_Source;
 241
 242    ---------------
 243    -- Load_Unit --
 244    ---------------
 245
 246    function Load_Unit
 247      (Load_Name  : Unit_Name_Type;
 248       Required   : Boolean;
 249       Error_Node : Node_Id;
 250       Subunit    : Boolean;
 251       Corr_Body  : Unit_Number_Type := No_Unit;
 252       Renamings  : Boolean          := False)
 253       return       Unit_Number_Type
 254    is
 255       Calling_Unit : Unit_Number_Type;
 256       Uname_Actual : Unit_Name_Type;
 257       Unum         : Unit_Number_Type;
 258       Unump        : Unit_Number_Type;
 259       Fname        : File_Name_Type;
 260       Src_Ind      : Source_File_Index;
 261
 262       procedure Set_Load_Unit_Dependency (U : Unit_Number_Type);
 263       --  Sets the Dependent_Unit flag unless we have a predefined unit
 264       --  being loaded in High_Integrity_Mode. In this case we do not want
 265       --  to create a dependency, since we have loaded the unit only
 266       --  to inline stuff from it. If this is not the case, an error
 267       --  message will be issued in Rtsfind in any case.
 268
 269       ------------------------------
 270       -- Set_Load_Unit_Dependency --
 271       ------------------------------
 272
 273       procedure Set_Load_Unit_Dependency (U : Unit_Number_Type) is
 274       begin
 275          --  Differentiate between pragma No_Run_Time mode (that can be
 276          --  used with a standard installation), and HI-E mode which comes
 277          --  with a special installation.
 278
 279          --  For Configurable_Run_Time_Mode set by a pragma, we do not want to
 280          --  create a dependency since the binder would generate references to
 281          --  these units. In the case of configurable run-time, we do want to
 282          --  establish this dependency.
 283
 284          if Configurable_Run_Time_Mode
 285            and then not Configurable_Run_Time_On_Target
 286            and then not Debug_Flag_YY
 287            and then Is_Internal_File_Name (Unit_File_Name (U))
 288          then
 289             null;
 290          else
 291             Units.Table (U).Dependent_Unit := True;
 292          end if;
 293       end Set_Load_Unit_Dependency;
 294
 295    --  Start of processing for Load_Unit
 296
 297    begin
 298       --  If renamings are allowed and we have a child unit name, then we
 299       --  must first load the parent to deal with finding the real name.
 300
 301       if Renamings and then Is_Child_Name (Load_Name) then
 302          Unump :=
 303            Load_Unit
 304              (Load_Name  => Get_Parent_Spec_Name (Load_Name),
 305               Required   => Required,
 306               Subunit    => False,
 307               Renamings  => True,
 308               Error_Node => Error_Node);
 309
 310          if Unump = No_Unit then
 311             return No_Unit;
 312          end if;
 313
 314          --  If parent is a renaming, then we use the renamed package as
 315          --  the actual parent for the subsequent load operation.
 316
 317          if Nkind (Parent (Cunit_Entity (Unump))) =
 318            N_Package_Renaming_Declaration
 319          then
 320             Uname_Actual :=
 321               New_Child
 322                 (Load_Name,
 323                  Get_Unit_Name (Name (Parent (Cunit_Entity (Unump)))));
 324
 325             --  Save the renaming entity, to establish its visibility when
 326             --  installing the context. The implicit with is on this entity,
 327             --  not on the package it renames.
 328
 329             if Nkind (Error_Node) = N_With_Clause
 330               and then Nkind (Name (Error_Node)) = N_Selected_Component
 331             then
 332                declare
 333                   Par : Node_Id := Name (Error_Node);
 334
 335                begin
 336                   while Nkind (Par) = N_Selected_Component
 337                     and then Chars (Selector_Name (Par)) /=
 338                       Chars (Cunit_Entity (Unump))
 339                   loop
 340                      Par := Prefix (Par);
 341                   end loop;
 342
 343                   if Nkind (Par) = N_Selected_Component then
 344                      --  some intermediate parent is a renaming.
 345
 346                      Set_Entity (Selector_Name (Par), Cunit_Entity (Unump));
 347
 348                   else
 349                      --  the ultimate parent is a renaming.
 350
 351                      Set_Entity (Par, Cunit_Entity (Unump));
 352                   end if;
 353                end;
 354             end if;
 355
 356          --  If the parent is not a renaming, then get its name (this may
 357          --  be different from the parent spec name obtained above because
 358          --  of renamings higher up in the hierarchy).
 359
 360          else
 361             Uname_Actual := New_Child (Load_Name, Unit_Name (Unump));
 362          end if;
 363
 364       --  Here if unit to be loaded is not a child unit
 365
 366       else
 367          Uname_Actual := Load_Name;
 368       end if;
 369
 370       Fname := Get_File_Name (Uname_Actual, Subunit);
 371
 372       if Debug_Flag_L then
 373          Write_Eol;
 374          Write_Str ("*** Load request for unit: ");
 375          Write_Unit_Name (Load_Name);
 376
 377          if Required then
 378             Write_Str (" (Required = True)");
 379          else
 380             Write_Str (" (Required = False)");
 381          end if;
 382
 383          Write_Eol;
 384
 385          if Uname_Actual /= Load_Name then
 386             Write_Str ("*** Actual unit loaded: ");
 387             Write_Unit_Name (Uname_Actual);
 388          end if;
 389       end if;
 390
 391       --  Capture error location if it is for the main unit. The idea is to
 392       --  post errors on the main unit location, not the most recent unit.
 393       --  Note: Unit_Name (Main_Unit) is not set if we are parsing gnat.adc.
 394
 395       if Present (Error_Node)
 396         and then Unit_Name (Main_Unit) /= No_Name
 397       then
 398          --  It seems like In_Extended_Main_Source_Unit (Error_Node) would
 399          --  do the trick here, but that's wrong, it is much too early to
 400          --  call this routine. We are still in the parser, and the required
 401          --  semantic information is not established yet. So we base the
 402          --  judgment on unit names.
 403
 404          Get_External_Unit_Name_String (Unit_Name (Main_Unit));
 405
 406          declare
 407             Main_Unit_Name : constant String := Name_Buffer (1 .. Name_Len);
 408
 409          begin
 410             Get_External_Unit_Name_String
 411               (Unit_Name (Get_Source_Unit (Error_Node)));
 412
 413             --  If the two names are identical, then for sure we are part
 414             --  of the extended main unit
 415
 416             if Main_Unit_Name = Name_Buffer (1 .. Name_Len) then
 417                Load_Msg_Sloc := Sloc (Error_Node);
 418
 419             --  If the load is called from a with_type clause, the error
 420             --  node is correct.
 421
 422             elsif Nkind (Parent (Error_Node)) = N_With_Type_Clause then
 423                Load_Msg_Sloc := Sloc (Error_Node);
 424
 425             --  Otherwise, check for the subunit case, and if so, consider
 426             --  we have a match if one name is a prefix of the other name.
 427
 428             else
 429                if Nkind (Unit (Cunit (Main_Unit))) = N_Subunit
 430                     or else
 431                   Nkind (Unit (Cunit (Get_Source_Unit (Error_Node)))) =
 432                                                                 N_Subunit
 433                then
 434                   Name_Len := Integer'Min (Name_Len, Main_Unit_Name'Length);
 435
 436                   if Name_Buffer (1 .. Name_Len)
 437                         =
 438                      Main_Unit_Name (1 .. Name_Len)
 439                   then
 440                      Load_Msg_Sloc := Sloc (Error_Node);
 441                   end if;
 442                end if;
 443             end if;
 444          end;
 445       end if;
 446
 447       --  If we are generating error messages, then capture calling unit
 448
 449       if Present (Error_Node) then
 450          Calling_Unit := Get_Source_Unit (Error_Node);
 451       else
 452          Calling_Unit := No_Unit;
 453       end if;
 454
 455       --  See if we already have an entry for this unit
 456
 457       Unum := Main_Unit;
 458
 459       while Unum <= Units.Last loop
 460          exit when Uname_Actual = Units.Table (Unum).Unit_Name;
 461          Unum := Unum + 1;
 462       end loop;
 463
 464       --  Whether or not the entry was found, Unum is now the right value,
 465       --  since it is one more than Units.Last (i.e. the index of the new
 466       --  entry we will create) in the not found case.
 467
 468       --  A special check is necessary in the unit not found case. If the unit
 469       --  is not found, but the file in which it lives has already been loaded,
 470       --  then we have the problem that the file does not contain the unit that
 471       --  is needed. We simply treat this as a file not found condition.
 472
 473       if Unum > Units.Last then
 474          for J in Units.First .. Units.Last loop
 475             if Fname = Units.Table (J).Unit_File_Name then
 476                if Debug_Flag_L then
 477                   Write_Str ("  file does not contain unit, Unit_Number = ");
 478                   Write_Int (Int (Unum));
 479                   Write_Eol;
 480                   Write_Eol;
 481                end if;
 482
 483                if Present (Error_Node) then
 484
 485                   if Is_Predefined_File_Name (Fname) then
 486                      Error_Msg_Name_1 := Uname_Actual;
 487                      Error_Msg
 488                        ("% is not a language defined unit", Load_Msg_Sloc);
 489                   else
 490                      Error_Msg_Name_1 := Fname;
 491                      Error_Msg_Unit_1 := Uname_Actual;
 492                      Error_Msg
 493                        ("File{ does not contain unit$", Load_Msg_Sloc);
 494                   end if;
 495
 496                   Write_Dependency_Chain;
 497                   return No_Unit;
 498
 499                else
 500                   return No_Unit;
 501                end if;
 502             end if;
 503          end loop;
 504       end if;
 505
 506       --  If we are proceeding with load, then make load stack entry
 507
 508       Load_Stack.Increment_Last;
 509       Load_Stack.Table (Load_Stack.Last) := Unum;
 510
 511       --  Case of entry already in table
 512
 513       if Unum <= Units.Last then
 514
 515          --  Here is where we check for a circular dependency, which is
 516          --  an attempt to load a unit which is currently in the process
 517          --  of being loaded. We do *not* care about a circular chain that
 518          --  leads back to a body, because this kind of circular dependence
 519          --  legitimately occurs (e.g. two package bodies that contain
 520          --  inlined subprogram referenced by the other).
 521
 522          --  We also ignore limited_with clauses, because their purpose is
 523          --  precisely to create legal circular structures.
 524
 525          if Loading (Unum)
 526            and then (Is_Spec_Name (Units.Table (Unum).Unit_Name)
 527                        or else Acts_As_Spec (Units.Table (Unum).Cunit))
 528            and then (Nkind (Error_Node) /= N_With_Clause
 529                        or else not Limited_Present (Error_Node))
 530
 531          then
 532             if Debug_Flag_L then
 533                Write_Str ("  circular dependency encountered");
 534                Write_Eol;
 535             end if;
 536
 537             if Present (Error_Node) then
 538                Error_Msg ("circular unit dependency", Load_Msg_Sloc);
 539                Write_Dependency_Chain;
 540             else
 541                Load_Stack.Decrement_Last;
 542             end if;
 543
 544             return No_Unit;
 545          end if;
 546
 547          if Debug_Flag_L then
 548             Write_Str ("  unit already in file table, Unit_Number = ");
 549             Write_Int (Int (Unum));
 550             Write_Eol;
 551          end if;
 552
 553          Load_Stack.Decrement_Last;
 554          Set_Load_Unit_Dependency (Unum);
 555          return Unum;
 556
 557       --  File is not already in table, so try to open it
 558
 559       else
 560          if Debug_Flag_L then
 561             Write_Str ("  attempt unit load, Unit_Number = ");
 562             Write_Int (Int (Unum));
 563             Write_Eol;
 564          end if;
 565
 566          Src_Ind := Load_Source_File (Fname);
 567
 568          --  Make a partial entry in the file table, used even in the file not
 569          --  found case to print the dependency chain including the last entry
 570
 571          Units.Increment_Last;
 572          Units.Table (Unum).Unit_Name := Uname_Actual;
 573
 574          --  File was found
 575
 576          if Src_Ind /= No_Source_File then
 577             Units.Table (Unum) := (
 578               Cunit           => Empty,
 579               Cunit_Entity    => Empty,
 580               Dependency_Num  => 0,
 581               Dependent_Unit  => False,
 582               Dynamic_Elab    => False,
 583               Error_Location  => Sloc (Error_Node),
 584               Expected_Unit   => Uname_Actual,
 585               Fatal_Error     => False,
 586               Generate_Code   => False,
 587               Has_RACW        => False,
 588               Ident_String    => Empty,
 589               Loading         => True,
 590               Main_Priority   => Default_Main_Priority,
 591               Serial_Number   => 0,
 592               Source_Index    => Src_Ind,
 593               Unit_File_Name  => Fname,
 594               Unit_Name       => Uname_Actual,
 595               Version         => Source_Checksum (Src_Ind));
 596
 597             --  Parse the new unit
 598
 599             Initialize_Scanner (Unum, Source_Index (Unum));
 600             Discard_List (Par (Configuration_Pragmas => False));
 601             Set_Loading (Unum, False);
 602
 603             --  If spec is irrelevant, then post errors and quit
 604
 605             if Corr_Body /= No_Unit
 606               and then Spec_Is_Irrelevant (Unum, Corr_Body)
 607             then
 608                Error_Msg_Name_1 := Unit_File_Name (Corr_Body);
 609                Error_Msg
 610                  ("cannot compile subprogram in file {!",
 611                   Load_Msg_Sloc);
 612                Error_Msg_Name_1 := Unit_File_Name (Unum);
 613                Error_Msg
 614                  ("incorrect spec in file { must be removed first!",
 615                   Load_Msg_Sloc);
 616                return No_Unit;
 617             end if;
 618
 619             --  If loaded unit had a fatal error, then caller inherits it!
 620
 621             if Units.Table (Unum).Fatal_Error
 622               and then Present (Error_Node)
 623             then
 624                Units.Table (Calling_Unit).Fatal_Error := True;
 625             end if;
 626
 627             --  Remove load stack entry and return the entry in the file table
 628
 629             Load_Stack.Decrement_Last;
 630             Set_Load_Unit_Dependency (Unum);
 631             return Unum;
 632
 633          --  Case of file not found
 634
 635          else
 636             if Debug_Flag_L then
 637                Write_Str ("  file was not found, load failed");
 638                Write_Eol;
 639             end if;
 640
 641             --  Generate message if unit required
 642
 643             if Required and then Present (Error_Node) then
 644
 645                if Is_Predefined_File_Name (Fname) then
 646                   Error_Msg_Name_1 := Uname_Actual;
 647                   Error_Msg
 648                     ("% is not a predefined library unit", Load_Msg_Sloc);
 649
 650                else
 651                   Error_Msg_Name_1 := Fname;
 652                   Error_Msg ("file{ not found", Load_Msg_Sloc);
 653                end if;
 654
 655                Write_Dependency_Chain;
 656
 657                --  Remove unit from stack, to avoid cascaded errors on
 658                --  subsequent missing files.
 659
 660                Load_Stack.Decrement_Last;
 661                Units.Decrement_Last;
 662
 663             --  If unit not required, remove load stack entry and the junk
 664             --  file table entry, and return No_Unit to indicate not found,
 665
 666             else
 667                Load_Stack.Decrement_Last;
 668                Units.Decrement_Last;
 669             end if;
 670
 671             return No_Unit;
 672          end if;
 673       end if;
 674    end Load_Unit;
 675
 676    ------------------------
 677    -- Make_Instance_Unit --
 678    ------------------------
 679
 680    --  If the unit is an instance, it appears as a package declaration, but
 681    --  contains both declaration and body of the instance. The body becomes
 682    --  the main unit of the compilation, and the declaration is inserted
 683    --  at the end of the unit table. The main unit now has the name of a
 684    --  body, which is constructed from the name of the original spec,
 685    --  and is attached to the compilation node of the original unit. The
 686    --  declaration has been attached to a new compilation unit node, and
 687    --  code will have to be generated for it.
 688
 689    procedure Make_Instance_Unit (N : Node_Id) is
 690       Sind : constant Source_File_Index := Source_Index (Main_Unit);
 691
 692    begin
 693       Units.Increment_Last;
 694
 695       Units.Table (Units.Last)               := Units.Table (Main_Unit);
 696       Units.Table (Units.Last).Cunit         := Library_Unit (N);
 697       Units.Table (Units.Last).Generate_Code := True;
 698
 699       Units.Table (Main_Unit).Cunit          := N;
 700       Units.Table (Main_Unit).Unit_Name      :=
 701         Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
 702       Units.Table (Main_Unit).Version        := Source_Checksum (Sind);
 703    end Make_Instance_Unit;
 704
 705    ------------------------
 706    -- Spec_Is_Irrelevant --
 707    ------------------------
 708
 709    function Spec_Is_Irrelevant
 710      (Spec_Unit : Unit_Number_Type;
 711       Body_Unit : Unit_Number_Type)
 712       return      Boolean
 713    is
 714       Sunit : constant Node_Id := Cunit (Spec_Unit);
 715       Bunit : constant Node_Id := Cunit (Body_Unit);
 716
 717    begin
 718       --  The spec is irrelevant if the body is a subprogram body, and the
 719       --  spec is other than a subprogram spec or generic subprogram spec.
 720       --  Note that the names must be the same, we don't need to check that,
 721       --  because we already know that from the fact that the file names are
 722       --  the same.
 723
 724       return
 725          Nkind (Unit (Bunit)) = N_Subprogram_Body
 726            and then Nkind (Unit (Sunit)) /= N_Subprogram_Declaration
 727            and then Nkind (Unit (Sunit)) /= N_Generic_Subprogram_Declaration;
 728
 729    end Spec_Is_Irrelevant;
 730
 731    --------------------
 732    -- Version_Update --
 733    --------------------
 734
 735    procedure Version_Update (U : Node_Id; From : Node_Id) is
 736       Unum  : constant Unit_Number_Type := Get_Cunit_Unit_Number (U);
 737       Fnum  : constant Unit_Number_Type := Get_Cunit_Unit_Number (From);
 738
 739    begin
 740
 741       if Source_Index (Fnum) /= No_Source_File then
 742          Units.Table (Unum).Version :=
 743            Units.Table (Unum).Version
 744              xor
 745               Source_Checksum (Source_Index (Fnum));
 746       end if;
 747    end Version_Update;
 748
 749    ----------------------------
 750    -- Write_Dependency_Chain --
 751    ----------------------------
 752
 753    procedure Write_Dependency_Chain is
 754    begin
 755       --  The dependency chain is only written if it is at least two entries
 756       --  deep, otherwise it is trivial (the main unit depending on a unit
 757       --  that it obviously directly depends on).
 758
 759       if Load_Stack.Last - 1 > Load_Stack.First then
 760          for U in Load_Stack.First .. Load_Stack.Last - 1 loop
 761             Error_Msg_Unit_1 := Unit_Name (Load_Stack.Table (U));
 762             Error_Msg_Unit_2 := Unit_Name (Load_Stack.Table (U + 1));
 763             Error_Msg ("$ depends on $!", Load_Msg_Sloc);
 764          end loop;
 765       end if;
 766    end Write_Dependency_Chain;
 767
 768 end Lib.Load;