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