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