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 --                            $Revision: 1.86 $
  10 --                                                                          --
  11 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Atree;    use Atree;
  30 with Debug;    use Debug;
  31 with Errout;   use Errout;
  32 with Fname;    use Fname;
  33 with Fname.UF; use Fname.UF;
  34 with Namet;    use Namet;
  35 with Nlists;   use Nlists;
  36 with Nmake;    use Nmake;
  37 with Opt;      use Opt;
  38 with Osint;    use Osint;
  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 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       procedure Set_Load_Unit_Dependency (U : Unit_Number_Type) is
 245       begin
 246          if No_Run_Time
 247            and then Is_Internal_File_Name (Unit_File_Name (U))
 248          then
 249             null;
 250          else
 251             Units.Table (U).Dependent_Unit := True;
 252          end if;
 253       end Set_Load_Unit_Dependency;
 254
 255    --  Start of processing for Load_Unit
 256
 257    begin
 258       --  If renamings are allowed and we have a child unit name, then we
 259       --  must first load the parent to deal with finding the real name.
 260
 261       if Renamings and then Is_Child_Name (Load_Name) then
 262          Unump :=
 263            Load_Unit
 264              (Load_Name  => Get_Parent_Spec_Name (Load_Name),
 265               Required   => Required,
 266               Subunit    => False,
 267               Renamings  => True,
 268               Error_Node => Error_Node);
 269
 270          if Unump = No_Unit then
 271             return No_Unit;
 272          end if;
 273
 274          --  If parent is a renaming, then we use the renamed package as
 275          --  the actual parent for the subsequent load operation.
 276
 277          if Nkind (Parent (Cunit_Entity (Unump))) =
 278            N_Package_Renaming_Declaration
 279          then
 280             Uname_Actual :=
 281               New_Child
 282                 (Load_Name,
 283                  Get_Unit_Name (Name (Parent (Cunit_Entity (Unump)))));
 284
 285             --  Save the renaming entity, to establish its visibility when
 286             --  installing the context. The implicit with is on this entity,
 287             --  not on the package it renames.
 288
 289             if Nkind (Error_Node) = N_With_Clause
 290               and then Nkind (Name (Error_Node)) = N_Selected_Component
 291             then
 292                declare
 293                   Par : Node_Id := Name (Error_Node);
 294
 295                begin
 296                   while Nkind (Par) = N_Selected_Component
 297                     and then Chars (Selector_Name (Par)) /=
 298                       Chars (Cunit_Entity (Unump))
 299                   loop
 300                      Par := Prefix (Par);
 301                   end loop;
 302
 303                   if Nkind (Par) = N_Selected_Component then
 304                      --  some intermediate parent is a renaming.
 305
 306                      Set_Entity (Selector_Name (Par), Cunit_Entity (Unump));
 307
 308                   else
 309                      --  the ultimate parent is a renaming.
 310
 311                      Set_Entity (Par, Cunit_Entity (Unump));
 312                   end if;
 313                end;
 314             end if;
 315
 316          --  If the parent is not a renaming, then get its name (this may
 317          --  be different from the parent spec name obtained above because
 318          --  of renamings higher up in the hierarchy).
 319
 320          else
 321             Uname_Actual := New_Child (Load_Name, Unit_Name (Unump));
 322          end if;
 323
 324       --  Here if unit to be loaded is not a child unit
 325
 326       else
 327          Uname_Actual := Load_Name;
 328       end if;
 329
 330       Fname := Get_File_Name (Uname_Actual, Subunit);
 331
 332       if Debug_Flag_L then
 333          Write_Eol;
 334          Write_Str ("*** Load request for unit: ");
 335          Write_Unit_Name (Load_Name);
 336
 337          if Required then
 338             Write_Str (" (Required = True)");
 339          else
 340             Write_Str (" (Required = False)");
 341          end if;
 342
 343          Write_Eol;
 344
 345          if Uname_Actual /= Load_Name then
 346             Write_Str ("*** Actual unit loaded: ");
 347             Write_Unit_Name (Uname_Actual);
 348          end if;
 349       end if;
 350
 351       --  Capture error location if it is for the main unit. The idea is to
 352       --  post errors on the main unit location, not the most recent unit.
 353
 354       if Present (Error_Node) then
 355
 356          --  It seems like In_Extended_Main_Source_Unit (Error_Node) would
 357          --  do the trick here, but that's wrong, it is much too early to
 358          --  call this routine. We are still in the parser, and the required
 359          --  semantic information is not established yet. So we base the
 360          --  judgment on unit names.
 361
 362          Get_External_Unit_Name_String (Unit_Name (Main_Unit));
 363
 364          declare
 365             Main_Unit_Name : constant String := Name_Buffer (1 .. Name_Len);
 366
 367          begin
 368             Get_External_Unit_Name_String
 369               (Unit_Name (Get_Source_Unit (Error_Node)));
 370
 371             --  If the two names are identical, then for sure we are part
 372             --  of the extended main unit
 373
 374             if Main_Unit_Name = Name_Buffer (1 .. Name_Len) then
 375                Load_Msg_Sloc := Sloc (Error_Node);
 376
 377             --  If the load is called from a with_type clause, the error
 378             --  node is correct.
 379
 380             elsif Nkind (Parent (Error_Node)) = N_With_Type_Clause then
 381                Load_Msg_Sloc := Sloc (Error_Node);
 382
 383             --  Otherwise, check for the subunit case, and if so, consider
 384             --  we have a match if one name is a prefix of the other name.
 385
 386             else
 387                if Nkind (Unit (Cunit (Main_Unit))) = N_Subunit
 388                     or else
 389                   Nkind (Unit (Cunit (Get_Source_Unit (Error_Node)))) =
 390                                                                 N_Subunit
 391                then
 392                   Name_Len := Integer'Min (Name_Len, Main_Unit_Name'Length);
 393
 394                   if Name_Buffer (1 .. Name_Len)
 395                         =
 396                      Main_Unit_Name (1 .. Name_Len)
 397                   then
 398                      Load_Msg_Sloc := Sloc (Error_Node);
 399                   end if;
 400                end if;
 401             end if;
 402          end;
 403       end if;
 404
 405       --  If we are generating error messages, then capture calling unit
 406
 407       if Present (Error_Node) then
 408          Calling_Unit := Get_Source_Unit (Error_Node);
 409       else
 410          Calling_Unit := No_Unit;
 411       end if;
 412
 413       --  See if we already have an entry for this unit
 414
 415       Unum := Main_Unit;
 416
 417       while Unum <= Units.Last loop
 418          exit when Uname_Actual = Units.Table (Unum).Unit_Name;
 419          Unum := Unum + 1;
 420       end loop;
 421
 422       --  Whether or not the entry was found, Unum is now the right value,
 423       --  since it is one more than Units.Last (i.e. the index of the new
 424       --  entry we will create) in the not found case.
 425
 426       --  A special check is necessary in the unit not found case. If the unit
 427       --  is not found, but the file in which it lives has already been loaded,
 428       --  then we have the problem that the file does not contain the unit that
 429       --  is needed. We simply treat this as a file not found condition.
 430
 431       if Unum > Units.Last then
 432          for J in Units.First .. Units.Last loop
 433             if Fname = Units.Table (J).Unit_File_Name then
 434                if Debug_Flag_L then
 435                   Write_Str ("  file does not contain unit, Unit_Number = ");
 436                   Write_Int (Int (Unum));
 437                   Write_Eol;
 438                   Write_Eol;
 439                end if;
 440
 441                if Present (Error_Node) then
 442
 443                   if Is_Predefined_File_Name (Fname) then
 444                      Error_Msg_Name_1 := Uname_Actual;
 445                      Error_Msg
 446                        ("% is not a language defined unit", Load_Msg_Sloc);
 447                   else
 448                      Error_Msg_Name_1 := Fname;
 449                      Error_Msg_Unit_1 := Uname_Actual;
 450                      Error_Msg
 451                        ("File{ does not contain unit$", Load_Msg_Sloc);
 452                   end if;
 453
 454                   Write_Dependency_Chain;
 455                   return No_Unit;
 456
 457                else
 458                   return No_Unit;
 459                end if;
 460             end if;
 461          end loop;
 462       end if;
 463
 464       --  If we are proceeding with load, then make load stack entry
 465
 466       Load_Stack.Increment_Last;
 467       Load_Stack.Table (Load_Stack.Last) := Unum;
 468
 469       --  Case of entry already in table
 470
 471       if Unum <= Units.Last then
 472
 473          --  Here is where we check for a circular dependency, which is
 474          --  an attempt to load a unit which is currently in the process
 475          --  of being loaded. We do *not* care about a circular chain that
 476          --  leads back to a body, because this kind of circular dependence
 477          --  legitimately occurs (e.g. two package bodies that contain
 478          --  inlined subprogram referenced by the other).
 479
 480          if Loading (Unum)
 481            and then (Is_Spec_Name (Units.Table (Unum).Unit_Name)
 482                        or else Acts_As_Spec (Units.Table (Unum).Cunit))
 483          then
 484             if Debug_Flag_L then
 485                Write_Str ("  circular dependency encountered");
 486                Write_Eol;
 487             end if;
 488
 489             if Present (Error_Node) then
 490                Error_Msg ("circular unit dependency", Load_Msg_Sloc);
 491                Write_Dependency_Chain;
 492             else
 493                Load_Stack.Decrement_Last;
 494             end if;
 495
 496             return No_Unit;
 497          end if;
 498
 499          if Debug_Flag_L then
 500             Write_Str ("  unit already in file table, Unit_Number = ");
 501             Write_Int (Int (Unum));
 502             Write_Eol;
 503          end if;
 504
 505          Load_Stack.Decrement_Last;
 506          Set_Load_Unit_Dependency (Unum);
 507          return Unum;
 508
 509       --  File is not already in table, so try to open it
 510
 511       else
 512          if Debug_Flag_L then
 513             Write_Str ("  attempt unit load, Unit_Number = ");
 514             Write_Int (Int (Unum));
 515             Write_Eol;
 516          end if;
 517
 518          Src_Ind := Load_Source_File (Fname);
 519
 520          --  Make a partial entry in the file table, used even in the file not
 521          --  found case to print the dependency chain including the last entry
 522
 523          Units.Increment_Last;
 524          Units.Table (Unum).Unit_Name := Uname_Actual;
 525
 526          --  File was found
 527
 528          if Src_Ind /= No_Source_File then
 529             Units.Table (Unum) := (
 530               Cunit           => Empty,
 531               Cunit_Entity    => Empty,
 532               Dependency_Num  => 0,
 533               Dependent_Unit  => False,
 534               Dynamic_Elab    => False,
 535               Error_Location  => Sloc (Error_Node),
 536               Expected_Unit   => Uname_Actual,
 537               Fatal_Error     => False,
 538               Generate_Code   => False,
 539               Has_RACW        => False,
 540               Ident_String    => Empty,
 541               Loading         => True,
 542               Main_Priority   => Default_Main_Priority,
 543               Serial_Number   => 0,
 544               Source_Index    => Src_Ind,
 545               Unit_File_Name  => Fname,
 546               Unit_Name       => Uname_Actual,
 547               Version         => Source_Checksum (Src_Ind));
 548
 549             --  Parse the new unit
 550
 551             Initialize_Scanner (Unum, Source_Index (Unum));
 552             Discard := Par (Configuration_Pragmas => False);
 553             Set_Loading (Unum, False);
 554
 555             --  If spec is irrelevant, then post errors and quit
 556
 557             if Corr_Body /= No_Unit
 558               and then Spec_Is_Irrelevant (Unum, Corr_Body)
 559             then
 560                Error_Msg_Name_1 := Unit_File_Name (Corr_Body);
 561                Error_Msg
 562                  ("cannot compile subprogram in file {!",
 563                   Load_Msg_Sloc);
 564                Error_Msg_Name_1 := Unit_File_Name (Unum);
 565                Error_Msg
 566                  ("incorrect spec in file { must be removed first!",
 567                   Load_Msg_Sloc);
 568                return No_Unit;
 569             end if;
 570
 571             --  If loaded unit had a fatal error, then caller inherits it!
 572
 573             if Units.Table (Unum).Fatal_Error
 574               and then Present (Error_Node)
 575             then
 576                Units.Table (Calling_Unit).Fatal_Error := True;
 577             end if;
 578
 579             --  Remove load stack entry and return the entry in the file table
 580
 581             Load_Stack.Decrement_Last;
 582             Set_Load_Unit_Dependency (Unum);
 583             return Unum;
 584
 585          --  Case of file not found
 586
 587          else
 588             if Debug_Flag_L then
 589                Write_Str ("  file was not found, load failed");
 590                Write_Eol;
 591             end if;
 592
 593             --  Generate message if unit required
 594
 595             if Required and then Present (Error_Node) then
 596
 597                if Is_Predefined_File_Name (Fname) then
 598                   Error_Msg_Name_1 := Uname_Actual;
 599                   Error_Msg
 600                     ("% is not a predefined library unit", Load_Msg_Sloc);
 601
 602                else
 603                   Error_Msg_Name_1 := Fname;
 604                   Error_Msg ("file{ not found", Load_Msg_Sloc);
 605                end if;
 606
 607                Write_Dependency_Chain;
 608
 609                --  Remove unit from stack, to avoid cascaded errors on
 610                --  subsequent missing files.
 611
 612                Load_Stack.Decrement_Last;
 613                Units.Decrement_Last;
 614
 615             --  If unit not required, remove load stack entry and the junk
 616             --  file table entry, and return No_Unit to indicate not found,
 617
 618             else
 619                Load_Stack.Decrement_Last;
 620                Units.Decrement_Last;
 621             end if;
 622
 623             return No_Unit;
 624          end if;
 625       end if;
 626    end Load_Unit;
 627
 628    ------------------------
 629    -- Make_Instance_Unit --
 630    ------------------------
 631
 632    --  If the unit is an instance, it appears as a package declaration, but
 633    --  contains both declaration and body of the instance. The body becomes
 634    --  the main unit of the compilation, and the declaration is inserted
 635    --  at the end of the unit table. The main unit now has the name of a
 636    --  body, which is constructed from the name of the original spec,
 637    --  and is attached to the compilation node of the original unit. The
 638    --  declaration has been attached to a new compilation unit node, and
 639    --  code will have to be generated for it.
 640
 641    procedure Make_Instance_Unit (N : Node_Id) is
 642       Sind : constant Source_File_Index := Source_Index (Main_Unit);
 643
 644    begin
 645       Units.Increment_Last;
 646
 647       Units.Table (Units.Last)               := Units.Table (Main_Unit);
 648       Units.Table (Units.Last).Cunit         := Library_Unit (N);
 649       Units.Table (Units.Last).Generate_Code := True;
 650
 651       Units.Table (Main_Unit).Cunit          := N;
 652       Units.Table (Main_Unit).Unit_Name      :=
 653         Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
 654       Units.Table (Main_Unit).Version        := Source_Checksum (Sind);
 655    end Make_Instance_Unit;
 656
 657    ------------------------
 658    -- Spec_Is_Irrelevant --
 659    ------------------------
 660
 661    function Spec_Is_Irrelevant
 662      (Spec_Unit : Unit_Number_Type;
 663       Body_Unit : Unit_Number_Type)
 664       return      Boolean
 665    is
 666       Sunit : constant Node_Id := Cunit (Spec_Unit);
 667       Bunit : constant Node_Id := Cunit (Body_Unit);
 668
 669    begin
 670       --  The spec is irrelevant if the body is a subprogram body, and the
 671       --  spec is other than a subprogram spec or generic subprogram spec.
 672       --  Note that the names must be the same, we don't need to check that,
 673       --  because we already know that from the fact that the file names are
 674       --  the same.
 675
 676       return
 677          Nkind (Unit (Bunit)) = N_Subprogram_Body
 678            and then Nkind (Unit (Sunit)) /= N_Subprogram_Declaration
 679            and then Nkind (Unit (Sunit)) /= N_Generic_Subprogram_Declaration;
 680
 681    end Spec_Is_Irrelevant;
 682
 683    --------------------
 684    -- Version_Update --
 685    --------------------
 686
 687    procedure Version_Update (U : Node_Id; From : Node_Id) is
 688       Unum  : constant Unit_Number_Type := Get_Cunit_Unit_Number (U);
 689       Fnum  : constant Unit_Number_Type := Get_Cunit_Unit_Number (From);
 690
 691    begin
 692       Units.Table (Unum).Version :=
 693         Units.Table (Unum).Version
 694           xor
 695         Source_Checksum (Source_Index (Fnum));
 696    end Version_Update;
 697
 698    ----------------------------
 699    -- Write_Dependency_Chain --
 700    ----------------------------
 701
 702    procedure Write_Dependency_Chain is
 703    begin
 704       --  The dependency chain is only written if it is at least two entries
 705       --  deep, otherwise it is trivial (the main unit depending on a unit
 706       --  that it obviously directly depends on).
 707
 708       if Load_Stack.Last - 1 > Load_Stack.First then
 709          for U in Load_Stack.First .. Load_Stack.Last - 1 loop
 710             Error_Msg_Unit_1 := Unit_Name (Load_Stack.Table (U));
 711             Error_Msg_Unit_2 := Unit_Name (Load_Stack.Table (U + 1));
 712             Error_Msg ("$ depends on $!", Load_Msg_Sloc);
 713          end loop;
 714       end if;
 715    end Write_Dependency_Chain;
 716
 717 end Lib.Load;