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