gcc/ada/mlib-prj.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                            M L I B . P R J                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --              Copyright (C) 2001-2003, Ada Core Technologies, 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 ALI;      use ALI;
  28 with Hostparm;
  29 with MLib.Fil; use MLib.Fil;
  30 with MLib.Tgt; use MLib.Tgt;
  31 with MLib.Utl; use MLib.Utl;
  32 with Namet;    use Namet;
  33 with Opt;
  34 with Output;   use Output;
  35 with Prj.Com;  use Prj.Com;
  36 with Prj.Env;  use Prj.Env;
  37 with Prj.Util; use Prj.Util;
  38 with Sinput.P;
  39 with Snames;   use Snames;
  40 with Table;
  41 with Types;    use Types;
  42
  43 with Ada.Characters.Handling;
  44
  45 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  46 with GNAT.HTable;
  47 with GNAT.OS_Lib;               use GNAT.OS_Lib;
  48 with Interfaces.C_Streams;      use Interfaces.C_Streams;
  49 with System;                    use System;
  50 with System.Case_Util;          use System.Case_Util;
  51
  52 package body MLib.Prj is
  53
  54    Prj_Add_Obj_Files : Types.Int;
  55    pragma Import (C, Prj_Add_Obj_Files, "__gnat_prj_add_obj_files");
  56    Add_Object_Files : constant Boolean := Prj_Add_Obj_Files /= 0;
  57    --  Indicates if object files in pragmas Linker_Options (found in the
  58    --  binder generated file) should be taken when linking aq stand-alone
  59    --  library.
  60    --  False for Windows, True for other platforms.
  61
  62    ALI_Suffix : constant String := ".ali";
  63    B_Start    : String := "b~";
  64
  65    S_Osinte_Ads : Name_Id := No_Name;
  66    --  Name_Id for "s-osinte.ads"
  67
  68    S_Dec_Ads : Name_Id := No_Name;
  69    --  Name_Id for "dec.ads"
  70
  71    No_Argument_List : aliased String_List := (1 .. 0 => null);
  72    No_Argument      : constant String_List_Access := No_Argument_List'Access;
  73
  74    Arguments : String_List_Access := No_Argument;
  75    --  Used to accumulate arguments for the invocation of gnatbind and of
  76    --  the compiler. Also used to collect the interface ALI when copying
  77    --  the ALI files to the library directory.
  78
  79    Argument_Number : Natural := 0;
  80    --  Index of the last argument in Arguments
  81
  82    Initial_Argument_Max : constant := 10;
  83
  84    No_Main_String : aliased String := "-n";
  85    No_Main : constant String_Access := No_Main_String'Access;
  86
  87    Output_Switch_String : aliased String := "-o";
  88    Output_Switch : constant String_Access := Output_Switch_String'Access;
  89
  90    Compile_Switch_String : aliased String := "-c";
  91    Compile_Switch : constant String_Access := Compile_Switch_String'Access;
  92
  93    --  List of objects to put inside the library
  94
  95    Object_Files : Argument_List_Access;
  96
  97    package Objects is new Table.Table
  98      (Table_Name           => "Mlib.Prj.Objects",
  99       Table_Component_Type => String_Access,
 100       Table_Index_Type     => Natural,
 101       Table_Low_Bound      => 1,
 102       Table_Initial        => 50,
 103       Table_Increment      => 100);
 104
 105    package Objects_Htable is new GNAT.HTable.Simple_HTable
 106      (Header_Num => Com.Header_Num,
 107       Element    => Boolean,
 108       No_Element => False,
 109       Key        => Name_Id,
 110       Hash       => Com.Hash,
 111       Equal      => "=");
 112
 113    --  List of non-Ada object files
 114
 115    Foreign_Objects : Argument_List_Access;
 116
 117    package Foreigns is new Table.Table
 118      (Table_Name           => "Mlib.Prj.Foreigns",
 119       Table_Component_Type => String_Access,
 120       Table_Index_Type     => Natural,
 121       Table_Low_Bound      => 1,
 122       Table_Initial        => 20,
 123       Table_Increment      => 100);
 124
 125    --  List of ALI files
 126
 127    Ali_Files : Argument_List_Access;
 128
 129    package ALIs is new Table.Table
 130      (Table_Name           => "Mlib.Prj.Alis",
 131       Table_Component_Type => String_Access,
 132       Table_Index_Type     => Natural,
 133       Table_Low_Bound      => 1,
 134       Table_Initial        => 50,
 135       Table_Increment      => 100);
 136
 137    --  List of options set in the command line.
 138
 139    Options : Argument_List_Access;
 140
 141    package Opts is new Table.Table
 142      (Table_Name           => "Mlib.Prj.Opts",
 143       Table_Component_Type => String_Access,
 144       Table_Index_Type     => Natural,
 145       Table_Low_Bound      => 1,
 146       Table_Initial        => 5,
 147       Table_Increment      => 100);
 148
 149    --  All the ALI file in the library
 150
 151    package Library_ALIs is new GNAT.HTable.Simple_HTable
 152      (Header_Num => Com.Header_Num,
 153       Element    => Boolean,
 154       No_Element => False,
 155       Key        => Name_Id,
 156       Hash       => Com.Hash,
 157       Equal      => "=");
 158
 159    --  The ALI files in the interface sets
 160
 161    package Interface_ALIs is new GNAT.HTable.Simple_HTable
 162      (Header_Num => Com.Header_Num,
 163       Element    => Boolean,
 164       No_Element => False,
 165       Key        => Name_Id,
 166       Hash       => Com.Hash,
 167       Equal      => "=");
 168
 169    --  The ALI files that have been processed to check if the corresponding
 170    --  library unit is in the interface set.
 171
 172    package Processed_ALIs is new GNAT.HTable.Simple_HTable
 173      (Header_Num => Com.Header_Num,
 174       Element    => Boolean,
 175       No_Element => False,
 176       Key        => Name_Id,
 177       Hash       => Com.Hash,
 178       Equal      => "=");
 179
 180    --  The projects imported directly or indirectly.
 181
 182    package Processed_Projects is new GNAT.HTable.Simple_HTable
 183      (Header_Num => Com.Header_Num,
 184       Element    => Boolean,
 185       No_Element => False,
 186       Key        => Name_Id,
 187       Hash       => Com.Hash,
 188       Equal      => "=");
 189
 190    --  The library projects imported directly or indirectly.
 191
 192    package Library_Projs is new Table.Table (
 193      Table_Component_Type => Project_Id,
 194      Table_Index_Type     => Integer,
 195      Table_Low_Bound      => 1,
 196      Table_Initial        => 10,
 197      Table_Increment      => 10,
 198      Table_Name           => "Make.Library_Projs");
 199
 200    type Build_Mode_State is (None, Static, Dynamic, Relocatable);
 201
 202    procedure Add_Argument (S : String);
 203    --  Add one argument to the array Arguments.
 204    --  If Arguments is full, double its size.
 205
 206    function ALI_File_Name (Source : String) return String;
 207    --  Return the ALI file name corresponding to a source.
 208
 209    procedure Check (Filename : String);
 210    --  Check if filename is a regular file. Fail if it is not.
 211
 212    procedure Check_Context;
 213    --  Check each object files in table Object_Files
 214    --  Fail if any of them is not a regular file
 215
 216    procedure Clean (Directory : Name_Id);
 217    --  Attempt to delete all files in Directory, but not subdirectories
 218
 219    procedure Copy_Interface_Sources
 220      (For_Project : Project_Id;
 221       Interfaces  : Argument_List;
 222       To_Dir      : Name_Id);
 223    --  Copy the interface sources of a SAL to directory To_Dir
 224
 225    procedure Display (Executable : String);
 226    --  Display invocation of gnatbind and of the compiler with the arguments
 227    --  in Arguments, except when Quiet_Output is True.
 228
 229    procedure Process_Binder_File (Name : String);
 230    --  For Stand-Alone libraries, get the Linker Options in the binder
 231    --  generated file.
 232
 233    procedure Reset_Tables;
 234    --  Make sure that all the above tables are empty
 235    --  (Objects, Foreign_Objects, Ali_Files, Options).
 236
 237    ------------------
 238    -- Add_Argument --
 239    ------------------
 240
 241    procedure Add_Argument (S : String) is
 242    begin
 243       if Argument_Number = Arguments'Last then
 244          declare
 245             New_Args : constant String_List_Access :=
 246               new String_List (1 .. 2 * Arguments'Last);
 247
 248          begin
 249             --  Copy the String_Accesses and set them to null in Arguments
 250             --  so that they will not be deallocated by the call to
 251             --  Free (Arguments).
 252
 253             New_Args (Arguments'Range) := Arguments.all;
 254             Arguments.all := (others => null);
 255             Free (Arguments);
 256             Arguments := New_Args;
 257          end;
 258       end if;
 259
 260       Argument_Number := Argument_Number + 1;
 261       Arguments (Argument_Number) := new String'(S);
 262    end Add_Argument;
 263
 264    -------------------
 265    -- ALI_File_Name --
 266    -------------------
 267
 268    function ALI_File_Name (Source : String) return String is
 269    begin
 270       --  If the source name has an extension, then replace it with
 271       --  the ALI suffix.
 272
 273       for Index in reverse Source'First + 1 .. Source'Last loop
 274          if Source (Index) = '.' then
 275             return Source (Source'First .. Index - 1) & ALI_Suffix;
 276          end if;
 277       end loop;
 278
 279       --  If there is no dot, or if it is the first character, just add the
 280       --  ALI suffix.
 281
 282       return Source & ALI_Suffix;
 283    end ALI_File_Name;
 284
 285    -------------------
 286    -- Build_Library --
 287    -------------------
 288
 289    procedure Build_Library
 290      (For_Project   : Project_Id;
 291       Gnatbind      : String;
 292       Gnatbind_Path : String_Access;
 293       Gcc           : String;
 294       Gcc_Path      : String_Access;
 295       Bind          : Boolean := True;
 296       Link          : Boolean := True)
 297    is
 298       Warning_For_Library : Boolean := False;
 299       --  Set to True for the first warning about a unit missing from the
 300       --  interface set.
 301
 302       Libgnarl_Needed   : Boolean := False;
 303       --  Set to True if library needs to be linked with libgnarl
 304
 305       Libdecgnat_Needed : Boolean := False;
 306       --  On OpenVMS, set to True if library needs to be linked with libdecgnat
 307
 308       Data : Project_Data := Projects.Table (For_Project);
 309
 310       Object_Directory_Path : constant String :=
 311                           Get_Name_String (Data.Object_Directory);
 312
 313       Standalone   : constant Boolean := Data.Standalone_Library;
 314
 315       Project_Name : constant String := Get_Name_String (Data.Name);
 316
 317       DLL_Address  : constant String_Access :=
 318                        new String'(Default_DLL_Address);
 319
 320       Current_Dir  : constant String := Get_Current_Dir;
 321
 322       Lib_Filename : String_Access;
 323       Lib_Dirpath  : String_Access;
 324       Lib_Version  : String_Access := new String'("");
 325
 326       The_Build_Mode : Build_Mode_State := None;
 327
 328       Success : Boolean := False;
 329
 330       Library_Options : Variable_Value := Nil_Variable_Value;
 331
 332       Library_GCC     : Variable_Value := Nil_Variable_Value;
 333
 334       Driver_Name : Name_Id := No_Name;
 335
 336       In_Main_Object_Directory : Boolean := True;
 337
 338       Rpath : String_Access := null;
 339       --  Allocated only if Path Option is supported
 340
 341       Rpath_Last : Natural := 0;
 342       --  Index of last valid character of Rpath
 343
 344       Initial_Rpath_Length : constant := 200;
 345       --  Initial size of Rpath, when first allocated
 346
 347       Path_Option : String_Access := Linker_Library_Path_Option;
 348       --  If null, Path Option is not supported.
 349       --  Not a constant so that it can be deallocated.
 350
 351       Copy_Dir : Name_Id;
 352       --  Directory where to copy ALI files and possibly interface sources
 353
 354       procedure Add_ALI_For (Source : Name_Id);
 355       --  Add the name of the ALI file corresponding to Source to the
 356       --  Arguments.
 357
 358       procedure Add_Rpath (Path : String);
 359       --  Add a path name to Rpath
 360
 361       function Check_Project (P : Project_Id) return Boolean;
 362       --  Returns True if P is For_Project or a project extended by For_Project
 363
 364       procedure Check_Libs (ALI_File : String);
 365       --  Set Libgnarl_Needed if the ALI_File indicates that there is a need
 366       --  to link with -lgnarl (this is the case when there is a dependency
 367       --  on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
 368       --  indicates that there is a need to link with -ldecgnat (this is the
 369       --  case when there is a dependency on dec.ads).
 370
 371       procedure Process (The_ALI : File_Name_Type);
 372       --  Check if the closure of a library unit which is or should be in the
 373       --  interface set is also in the interface set. Issue a warning for each
 374       --  missing library unit.
 375
 376       procedure Process_Imported_Libraries;
 377       --  Add the -L and -l switches for the imported Library Project Files,
 378       --  and, if Path Option is supported, the library directory path names
 379       --  to Rpath.
 380
 381       -----------------
 382       -- Add_ALI_For --
 383       -----------------
 384
 385       procedure Add_ALI_For (Source : Name_Id) is
 386          ALI : constant String := ALI_File_Name (Get_Name_String (Source));
 387       begin
 388          Add_Argument (ALI);
 389
 390          --  Add the ALI file name to the library ALIs
 391
 392          Name_Len := 0;
 393          Add_Str_To_Name_Buffer (S => ALI);
 394          Library_ALIs.Set (Name_Find, True);
 395       end Add_ALI_For;
 396
 397       ---------------
 398       -- Add_Rpath --
 399       ---------------
 400
 401       procedure Add_Rpath (Path : String) is
 402
 403          procedure Double;
 404          --  Double Rpath size
 405
 406          ------------
 407          -- Double --
 408          ------------
 409
 410          procedure Double is
 411             New_Rpath : constant String_Access :=
 412                           new String (1 .. 2 * Rpath'Length);
 413          begin
 414             New_Rpath (1 .. Rpath_Last) := Rpath (1 .. Rpath_Last);
 415             Free (Rpath);
 416             Rpath := New_Rpath;
 417          end Double;
 418
 419       --  Start of processing for Add_Rpath
 420
 421       begin
 422          --  If firt path, allocate initial Rpath
 423
 424          if Rpath = null then
 425             Rpath := new String (1 .. Initial_Rpath_Length);
 426             Rpath_Last := 0;
 427
 428          else
 429             --  Otherwise, add a path separator between two path names
 430
 431             if Rpath_Last = Rpath'Last then
 432                Double;
 433             end if;
 434
 435             Rpath_Last := Rpath_Last + 1;
 436             Rpath (Rpath_Last) := Path_Separator;
 437          end if;
 438
 439          --  Increase Rpath size until it is large enough
 440
 441          while Rpath_Last + Path'Length > Rpath'Last loop
 442             Double;
 443          end loop;
 444
 445          --  Add the path name
 446
 447          Rpath (Rpath_Last + 1 .. Rpath_Last + Path'Length) := Path;
 448          Rpath_Last := Rpath_Last + Path'Length;
 449       end Add_Rpath;
 450
 451       -------------------
 452       -- Check_Project --
 453       -------------------
 454
 455       function Check_Project (P : Project_Id) return Boolean is
 456       begin
 457          if P = For_Project then
 458             return True;
 459
 460          elsif P /= No_Project then
 461             declare
 462                Data : Project_Data := Projects.Table (For_Project);
 463
 464             begin
 465                while Data.Extends /= No_Project loop
 466                   if P = Data.Extends then
 467                      return True;
 468                   end if;
 469
 470                   Data := Projects.Table (Data.Extends);
 471                end loop;
 472             end;
 473          end if;
 474
 475          return False;
 476       end Check_Project;
 477
 478       ----------------
 479       -- Check_Libs --
 480       ----------------
 481
 482       procedure Check_Libs (ALI_File : String) is
 483          Lib_File : Name_Id;
 484          Text     : Text_Buffer_Ptr;
 485          Id       : ALI.ALI_Id;
 486
 487          pragma Warnings (Off, Id);
 488          --  Comment needed ???
 489
 490       begin
 491          if not Libgnarl_Needed or
 492            (Hostparm.OpenVMS and then (not Libdecgnat_Needed))
 493          then
 494             --  Scan the ALI file
 495
 496             Name_Len := ALI_File'Length;
 497             Name_Buffer (1 .. Name_Len) := ALI_File;
 498             Lib_File := Name_Find;
 499             Text := Read_Library_Info (Lib_File, True);
 500
 501             Id  := ALI.Scan_ALI
 502                          (F          => Lib_File,
 503                           T          => Text,
 504                           Ignore_ED  => False,
 505                           Err        => True,
 506                           Read_Lines => "D");
 507             Free (Text);
 508
 509             --  Look for s-osinte.ads in the dependencies
 510
 511             for Index in ALI.ALIs.Table (Id).First_Sdep ..
 512                          ALI.ALIs.Table (Id).Last_Sdep
 513             loop
 514                if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
 515                   Libgnarl_Needed := True;
 516
 517                elsif Hostparm.OpenVMS and then
 518                      ALI.Sdep.Table (Index).Sfile = S_Dec_Ads
 519                then
 520                   Libdecgnat_Needed := True;
 521                end if;
 522             end loop;
 523          end if;
 524       end Check_Libs;
 525
 526       -------------
 527       -- Process --
 528       -------------
 529
 530       procedure Process (The_ALI : File_Name_Type) is
 531          Text       : Text_Buffer_Ptr;
 532          Idread     : ALI_Id;
 533          First_Unit : ALI.Unit_Id;
 534          Last_Unit  : ALI.Unit_Id;
 535          Unit_Data  : Unit_Record;
 536          Afile      : File_Name_Type;
 537
 538       begin
 539          --  Nothing to do if the ALI file has already been processed.
 540          --  This happens if an interface imports another interface.
 541
 542          if not Processed_ALIs.Get (The_ALI) then
 543             Processed_ALIs.Set (The_ALI, True);
 544             Text := Read_Library_Info (The_ALI);
 545
 546             if Text /= null then
 547                Idread :=
 548                  Scan_ALI
 549                    (F         => The_ALI,
 550                     T         => Text,
 551                     Ignore_ED => False,
 552                     Err       => True);
 553                Free (Text);
 554
 555                if Idread /= No_ALI_Id then
 556                   First_Unit := ALI.ALIs.Table (Idread).First_Unit;
 557                   Last_Unit  := ALI.ALIs.Table (Idread).Last_Unit;
 558
 559                   --  Process both unit (spec and body) if the body is needed
 560                   --  by the spec (inline or generic). Otherwise, just process
 561                   --  the spec.
 562
 563                   if First_Unit /= Last_Unit and then
 564                     not ALI.Units.Table (Last_Unit).Body_Needed_For_SAL
 565                   then
 566                      First_Unit := Last_Unit;
 567                   end if;
 568
 569                   for Unit in First_Unit .. Last_Unit loop
 570                      Unit_Data := ALI.Units.Table (Unit);
 571
 572                      --  Check if each withed unit which is in the library is
 573                      --  also in the interface set, if it has not yet been
 574                      --  processed.
 575
 576                      for W in Unit_Data.First_With .. Unit_Data.Last_With loop
 577                         Afile := Withs.Table (W).Afile;
 578
 579                         if Library_ALIs.Get (Afile)
 580                           and then not Processed_ALIs.Get (Afile)
 581                         then
 582                            if not Interface_ALIs.Get (Afile) then
 583                               if not Warning_For_Library then
 584                                  Write_Str ("Warning: In library project """);
 585                                  Get_Name_String (Data.Name);
 586                                  To_Mixed (Name_Buffer (1 .. Name_Len));
 587                                  Write_Str (Name_Buffer (1 .. Name_Len));
 588                                  Write_Line ("""");
 589                                  Warning_For_Library := True;
 590                               end if;
 591
 592                               Write_Str ("         Unit """);
 593                               Get_Name_String (Withs.Table (W).Uname);
 594                               To_Mixed (Name_Buffer (1 .. Name_Len - 2));
 595                               Write_Str (Name_Buffer (1 .. Name_Len - 2));
 596                               Write_Line (""" is not in the interface set");
 597                               Write_Str ("         but it is needed by ");
 598
 599                               case Unit_Data.Utype is
 600                                  when Is_Spec =>
 601                                     Write_Str ("the spec of ");
 602
 603                                  when Is_Body =>
 604                                     Write_Str ("the body of ");
 605
 606                                  when others =>
 607                                     null;
 608                               end case;
 609
 610                               Write_Str ("""");
 611                               Get_Name_String (Unit_Data.Uname);
 612                               To_Mixed (Name_Buffer (1 .. Name_Len - 2));
 613                               Write_Str (Name_Buffer (1 .. Name_Len - 2));
 614                               Write_Line ("""");
 615                            end if;
 616
 617                            --  Now, process this unit
 618
 619                            Process (Afile);
 620                         end if;
 621                      end loop;
 622                   end loop;
 623                end if;
 624             end if;
 625          end if;
 626       end Process;
 627
 628       --------------------------------
 629       -- Process_Imported_Libraries --
 630       --------------------------------
 631
 632       procedure Process_Imported_Libraries is
 633          Current : Project_Id;
 634
 635          procedure Process_Project (Project : Project_Id);
 636          --  Process Project and its imported projects recursively.
 637          --  Add any library projects to table Library_Projs.
 638
 639          ---------------------
 640          -- Process_Project --
 641          ---------------------
 642
 643          procedure Process_Project (Project : Project_Id) is
 644             Data     : constant Project_Data := Projects.Table (Project);
 645             Imported : Project_List := Data.Imported_Projects;
 646             Element  : Project_Element;
 647
 648          begin
 649             --  Nothing to do if process has already been processed.
 650
 651             if not Processed_Projects.Get (Data.Name) then
 652                Processed_Projects.Set (Data.Name, True);
 653
 654                --  If it is a library project, add it to Library_Projs
 655
 656                if Project /= For_Project and then Data.Library then
 657                   Library_Projs.Increment_Last;
 658                   Library_Projs.Table (Library_Projs.Last) := Project;
 659                end if;
 660
 661                --  Call Process_Project recursively for any imported project
 662
 663                while Imported /= Empty_Project_List loop
 664                   Element := Project_Lists.Table (Imported);
 665
 666                   if Element.Project /= No_Project then
 667                      Process_Project (Element.Project);
 668                   end if;
 669
 670                   Imported := Element.Next;
 671                end loop;
 672             end if;
 673          end Process_Project;
 674
 675       --  Start of processing for Process_Imported_Libraries
 676
 677       begin
 678          --  Build list of library projects imported directly or indirectly
 679
 680          Process_Project (For_Project);
 681
 682          --  If there are more that one library project file, make sure
 683          --  that if libA depends on libB, libB is first in order.
 684
 685          if Library_Projs.Last > 1 then
 686             declare
 687                Index : Integer := 1;
 688                Proj1 : Project_Id;
 689                Proj2 : Project_Id;
 690                List  : Project_List := Empty_Project_List;
 691
 692             begin
 693                Library_Loop : while Index < Library_Projs.Last loop
 694                   Proj1 := Library_Projs.Table (Index);
 695                   List  := Projects.Table (Proj1).Imported_Projects;
 696
 697                   List_Loop : while List /= Empty_Project_List loop
 698                      Proj2 := Project_Lists.Table (List).Project;
 699
 700                      for J in Index + 1 .. Library_Projs.Last loop
 701                         if Proj2 = Library_Projs.Table (J) then
 702                            Library_Projs.Table (J) := Proj1;
 703                            Library_Projs.Table (Index) := Proj2;
 704                            exit List_Loop;
 705                         end if;
 706                      end loop;
 707
 708                      List := Project_Lists.Table (List).Next;
 709                   end loop List_Loop;
 710
 711                   if List = Empty_Project_List then
 712                      Index := Index + 1;
 713                   end if;
 714                end loop Library_Loop;
 715             end;
 716          end if;
 717
 718          --  Now that we have a correct order, add the -L and -l switches and,
 719          --  if the Rpath option is supported, add the directory to the Rpath.
 720
 721          for Index in 1 .. Library_Projs.Last loop
 722             Current := Library_Projs.Table (Index);
 723
 724             Opts.Increment_Last;
 725             Opts.Table (Opts.Last) :=
 726               new String'
 727                 ("-L" &
 728                  Get_Name_String
 729                    (Projects.Table (Current).Library_Dir));
 730
 731             if Path_Option /= null then
 732                Add_Rpath
 733                   (Get_Name_String
 734                      (Projects.Table (Current).Library_Dir));
 735             end if;
 736
 737             Opts.Increment_Last;
 738             Opts.Table (Opts.Last) :=
 739               new String'
 740                 ("-l" &
 741                  Get_Name_String
 742                    (Projects.Table (Current).Library_Name));
 743          end loop;
 744       end Process_Imported_Libraries;
 745
 746    --  Start of processing for Build_Library
 747
 748    begin
 749       Reset_Tables;
 750
 751       --  Fail if project is not a library project
 752
 753       if not Data.Library then
 754          Com.Fail ("project """, Project_Name, """ has no library");
 755       end if;
 756
 757       --  If this is the first time Build_Library is called, get the Name_Id
 758       --  of "s-osinte.ads".
 759
 760       if S_Osinte_Ads = No_Name then
 761          Name_Len := 12;
 762          Name_Buffer (1 .. Name_Len) := "s-osinte.ads";
 763          S_Osinte_Ads := Name_Find;
 764       end if;
 765
 766       if S_Dec_Ads = No_Name then
 767          Name_Len := 7;
 768          Name_Buffer (1 .. Name_Len) := "dec.ads";
 769          S_Dec_Ads := Name_Find;
 770       end if;
 771
 772       --  We work in the object directory
 773
 774       Change_Dir (Object_Directory_Path);
 775
 776       if Standalone then
 777          --  Call gnatbind only if Bind is True
 778
 779          if Bind then
 780             if Gnatbind_Path = null then
 781                Com.Fail ("unable to locate ", Gnatbind);
 782             end if;
 783
 784             if Gcc_Path = null then
 785                Com.Fail ("unable to locate ", Gcc);
 786             end if;
 787
 788             --  Allocate Arguments, if it is the first time we see a standalone
 789             --  library.
 790
 791             if Arguments = No_Argument then
 792                Arguments := new String_List (1 .. Initial_Argument_Max);
 793             end if;
 794
 795             --  Add "-n -o b~<lib>.adb (b$<lib>.adb on VMS) -L<lib>"
 796
 797             Argument_Number := 2;
 798             Arguments (1) := No_Main;
 799             Arguments (2) := Output_Switch;
 800
 801             if Hostparm.OpenVMS then
 802                B_Start (B_Start'Last) := '$';
 803             end if;
 804
 805             Add_Argument
 806               (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
 807             Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
 808
 809             --  Check if Binder'Default_Switches ("Ada) is defined. If it is,
 810             --  add these switches to call gnatbind.
 811
 812             declare
 813                Binder_Package : constant Package_Id :=
 814                  Value_Of
 815                    (Name        => Name_Binder,
 816                     In_Packages => Data.Decl.Packages);
 817             begin
 818                if Binder_Package /= No_Package then
 819                   declare
 820                      Defaults : constant Array_Element_Id :=
 821                                   Value_Of
 822                                     (Name      => Name_Default_Switches,
 823                                      In_Arrays =>
 824                                        Packages.Table
 825                                          (Binder_Package).Decl.Arrays);
 826                      Switches : Variable_Value :=
 827                                   Value_Of
 828                                     (Index => Name_Ada, In_Array => Defaults);
 829                      Switch : String_List_Id := Nil_String;
 830                   begin
 831                      if not Switches.Default then
 832                         Switch := Switches.Values;
 833
 834                         while Switch /= Nil_String loop
 835                            Add_Argument
 836                              (Get_Name_String
 837                                 (String_Elements.Table (Switch).Value));
 838                            Switch := String_Elements.Table (Switch).Next;
 839                         end loop;
 840                      end if;
 841                   end;
 842                end if;
 843             end;
 844
 845             --  Get all the ALI files of the project file
 846
 847             declare
 848                Unit : Unit_Data;
 849
 850             begin
 851                Library_ALIs.Reset;
 852                Interface_ALIs.Reset;
 853                Processed_ALIs.Reset;
 854                for Source in 1 .. Com.Units.Last loop
 855                   Unit := Com.Units.Table (Source);
 856
 857                   if Unit.File_Names (Body_Part).Name /= No_Name
 858                     and then Unit.File_Names (Body_Part).Path /= Slash
 859                   then
 860                      if
 861                        Check_Project (Unit.File_Names (Body_Part).Project)
 862                      then
 863                         if Unit.File_Names (Specification).Name = No_Name then
 864                            declare
 865                               Src_Ind : Source_File_Index;
 866
 867                            begin
 868                               Src_Ind := Sinput.P.Load_Project_File
 869                                 (Get_Name_String
 870                                    (Unit.File_Names
 871                                       (Body_Part).Path));
 872
 873                               --  Add the ALI file only if it is not a subunit
 874
 875                               if
 876                               not Sinput.P.Source_File_Is_Subunit (Src_Ind)
 877                               then
 878                                  Add_ALI_For
 879                                    (Unit.File_Names (Body_Part).Name);
 880                               end if;
 881                            end;
 882
 883                         else
 884                            Add_ALI_For (Unit.File_Names (Body_Part).Name);
 885                         end if;
 886                      end if;
 887
 888                   elsif Unit.File_Names (Specification).Name /= No_Name
 889                     and then Unit.File_Names (Specification).Path /= Slash
 890                     and then Check_Project
 891                       (Unit.File_Names (Specification).Project)
 892                   then
 893                      Add_ALI_For (Unit.File_Names (Specification).Name);
 894                   end if;
 895                end loop;
 896             end;
 897
 898             --  Set the paths
 899
 900             Set_Ada_Paths
 901               (Project => For_Project, Including_Libraries => True);
 902
 903             --  Display the gnatbind command, if not in quiet output
 904
 905             Display (Gnatbind);
 906
 907             --  Invoke gnatbind
 908
 909             GNAT.OS_Lib.Spawn
 910               (Gnatbind_Path.all, Arguments (1 .. Argument_Number), Success);
 911
 912             if not Success then
 913                Com.Fail ("could not bind standalone library ",
 914                          Get_Name_String (Data.Library_Name));
 915             end if;
 916
 917          end if;
 918
 919          --  Compile the binder generated file only if Link is true
 920
 921          if Link then
 922             --  Set the paths
 923
 924             Set_Ada_Paths
 925               (Project => For_Project, Including_Libraries => True);
 926
 927             --  Invoke <gcc> -c b$$<lib>.adb
 928
 929             --  Allocate Arguments, if it is the first time we see a standalone
 930             --  library.
 931
 932             if Arguments = No_Argument then
 933                Arguments := new String_List (1 .. Initial_Argument_Max);
 934             end if;
 935
 936             Argument_Number := 1;
 937             Arguments (1) := Compile_Switch;
 938
 939             if Hostparm.OpenVMS then
 940                B_Start (B_Start'Last) := '$';
 941             end if;
 942
 943             Add_Argument
 944               (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
 945
 946             --  If necessary, add the PIC option
 947
 948             if PIC_Option /= "" then
 949                Add_Argument (PIC_Option);
 950             end if;
 951
 952             Display (Gcc);
 953             GNAT.OS_Lib.Spawn
 954               (Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
 955
 956             if not Success then
 957                Com.Fail
 958                  ("could not compile binder generated file for library ",
 959                   Get_Name_String (Data.Library_Name));
 960             end if;
 961
 962             --  Process binder generated file for pragmas Linker_Options
 963
 964             Process_Binder_File (Arguments (2).all & ASCII.NUL);
 965          end if;
 966       end if;
 967
 968       --  Build the library only if Link is True
 969
 970       if Link then
 971          --  If attribute Library_GCC was specified, get the driver name
 972
 973          Library_GCC := Value_Of (Name_Library_GCC, Data.Decl.Attributes);
 974
 975          if not Library_GCC.Default then
 976             Driver_Name := Library_GCC.Value;
 977          end if;
 978
 979          --  If attribute Library_Options was specified, add these additional
 980          --  options.
 981
 982          Library_Options :=
 983            Value_Of (Name_Library_Options, Data.Decl.Attributes);
 984
 985          if not Library_Options.Default then
 986             declare
 987                Current : String_List_Id := Library_Options.Values;
 988                Element : String_Element;
 989
 990             begin
 991                while Current /= Nil_String loop
 992                   Element := String_Elements.Table (Current);
 993                   Get_Name_String (Element.Value);
 994
 995                   if Name_Len /= 0 then
 996                      Opts.Increment_Last;
 997                      Opts.Table (Opts.Last) :=
 998                        new String'(Name_Buffer (1 .. Name_Len));
 999                   end if;
1000
1001                   Current := Element.Next;
1002                end loop;
1003             end;
1004          end if;
1005
1006          Lib_Dirpath  := new String'(Get_Name_String (Data.Library_Dir));
1007          Lib_Filename := new String'(Get_Name_String (Data.Library_Name));
1008
1009          case Data.Library_Kind is
1010             when Static =>
1011                The_Build_Mode := Static;
1012
1013             when Dynamic =>
1014                The_Build_Mode := Dynamic;
1015
1016             when Relocatable =>
1017                The_Build_Mode := Relocatable;
1018
1019                if PIC_Option /= "" then
1020                   Opts.Increment_Last;
1021                   Opts.Table (Opts.Last) := new String'(PIC_Option);
1022                end if;
1023          end case;
1024
1025          --  Get the library version, if any
1026
1027          if Data.Lib_Internal_Name /= No_Name then
1028             Lib_Version :=
1029               new String'(Get_Name_String (Data.Lib_Internal_Name));
1030          end if;
1031
1032          --  Add the objects found in the object directory and the object
1033          --  directories of the extended files, if any, except for generated
1034          --  object files (b~.. or B$..) from extended projects.
1035          --  When there are one or more extended files, only add an object file
1036          --  if no object file with the same name have already been added.
1037
1038          In_Main_Object_Directory := True;
1039
1040          loop
1041             declare
1042                Object_Dir_Path : constant String :=
1043                                    Get_Name_String (Data.Object_Directory);
1044                Object_Dir      : Dir_Type;
1045                Filename        : String (1 .. 255);
1046                Last            : Natural;
1047                Id              : Name_Id;
1048
1049             begin
1050                Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path);
1051
1052                --  For all entries in the object directory
1053
1054                loop
1055                   Read (Object_Dir, Filename, Last);
1056
1057                   exit when Last = 0;
1058
1059                   --  Check if it is an object file
1060
1061                   if Is_Obj (Filename (1 .. Last)) then
1062                      declare
1063                         Object_Path : String :=
1064                           Normalize_Pathname
1065                             (Object_Dir_Path & Directory_Separator &
1066                              Filename (1 .. Last));
1067
1068                      begin
1069                         Canonical_Case_File_Name (Object_Path);
1070                         Canonical_Case_File_Name (Filename (1 .. Last));
1071
1072                         --  If in the object directory of an extended project,
1073                         --  do not consider generated object files.
1074
1075                         if In_Main_Object_Directory or else
1076                           Last < 5 or else
1077                           Filename (1 .. B_Start'Length) /= B_Start
1078                         then
1079                            Name_Len := Last;
1080                            Name_Buffer (1 .. Name_Len) := Filename (1 .. Last);
1081                            Id := Name_Find;
1082
1083                            if not Objects_Htable.Get (Id) then
1084
1085                               --  Record this object file
1086
1087                               Objects_Htable.Set (Id, True);
1088                               Objects.Increment_Last;
1089                               Objects.Table (Objects.Last) :=
1090                                 new String'(Object_Path);
1091
1092                               declare
1093                                  ALI_File : constant String :=
1094                                               Ext_To (Object_Path, "ali");
1095
1096                               begin
1097                                  if Is_Regular_File (ALI_File) then
1098
1099                                     --  Record the ALI file
1100
1101                                     ALIs.Increment_Last;
1102                                     ALIs.Table (ALIs.Last) :=
1103                                       new String'(ALI_File);
1104
1105                                     --  Find out if for this ALI file,
1106                                     --  libgnarl or libdecgnat (on OpenVMS)
1107                                     --  is necessary.
1108
1109                                     Check_Libs (ALI_File);
1110
1111                                  else
1112                                     --  The object file is a foreign object
1113                                     --  file.
1114
1115                                     Foreigns.Increment_Last;
1116                                     Foreigns.Table (Foreigns.Last) :=
1117                                       new String'(Object_Path);
1118                                  end if;
1119                               end;
1120                            end if;
1121                         end if;
1122                      end;
1123                   end if;
1124                end loop;
1125
1126                Close (Dir => Object_Dir);
1127
1128             exception
1129                when Directory_Error =>
1130                   Com.Fail ("cannot find object directory """,
1131                             Get_Name_String (Data.Object_Directory),
1132                             """");
1133             end;
1134
1135             exit when Data.Extends = No_Project;
1136
1137             In_Main_Object_Directory  := False;
1138             Data := Projects.Table (Data.Extends);
1139          end loop;
1140
1141          --  Add the -L and -l switches for the imported Library Project Files,
1142          --  and, if Path Option is supported, the library directory path names
1143          --  to Rpath.
1144
1145          Process_Imported_Libraries;
1146
1147          --  Link with libgnat and possibly libgnarl
1148
1149          Opts.Increment_Last;
1150          Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory);
1151
1152          --  If Path Option is supported, add libgnat directory path name to
1153          --  Rpath.
1154
1155          if Path_Option /= null then
1156             Add_Rpath (Lib_Directory);
1157          end if;
1158
1159          if Libgnarl_Needed then
1160             Opts.Increment_Last;
1161             Opts.Table (Opts.Last) := new String'("-lgnarl");
1162          end if;
1163
1164          if Libdecgnat_Needed then
1165             Opts.Increment_Last;
1166             Opts.Table (Opts.Last) :=
1167               new String'("-L" & Lib_Directory & "/../declib");
1168             Opts.Increment_Last;
1169             Opts.Table (Opts.Last) := new String'("-ldecgnat");
1170          end if;
1171
1172          Opts.Increment_Last;
1173          Opts.Table (Opts.Last) := new String'("-lgnat");
1174
1175          --  If Path Option is supported, add the necessary switch with the
1176          --  content of Rpath. As Rpath contains at least libgnat directory
1177          --  path name, it is guaranteed that it is not null.
1178
1179          if Path_Option /= null then
1180             Opts.Increment_Last;
1181             Opts.Table (Opts.Last) :=
1182               new String'(Path_Option.all & Rpath (1 .. Rpath_Last));
1183             Free (Path_Option);
1184             Free (Rpath);
1185          end if;
1186
1187          Object_Files :=
1188            new Argument_List'
1189              (Argument_List (Objects.Table (1 .. Objects.Last)));
1190
1191          Foreign_Objects :=
1192            new Argument_List'(Argument_List
1193                                 (Foreigns.Table (1 .. Foreigns.Last)));
1194
1195          Ali_Files :=
1196            new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
1197
1198          Options :=
1199            new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
1200
1201          --  We fail if there are no object to put in the library
1202          --  (Ada or foreign objects).
1203
1204          if Object_Files'Length = 0 then
1205             Com.Fail ("no object files for library """ &
1206                       Lib_Filename.all & '"');
1207
1208          end if;
1209
1210          if not Opt.Quiet_Output then
1211             Write_Eol;
1212             Write_Str  ("building ");
1213             Write_Str (Ada.Characters.Handling.To_Lower
1214                          (Build_Mode_State'Image (The_Build_Mode)));
1215             Write_Str  (" library for project ");
1216             Write_Line (Project_Name);
1217
1218             Write_Eol;
1219
1220             Write_Line ("object files:");
1221
1222             for Index in Object_Files'Range loop
1223                Write_Str  ("   ");
1224                Write_Line (Object_Files (Index).all);
1225             end loop;
1226
1227             Write_Eol;
1228
1229             if Ali_Files'Length = 0 then
1230                Write_Line ("NO ALI files");
1231
1232             else
1233                Write_Line ("ALI files:");
1234
1235                for Index in Ali_Files'Range loop
1236                   Write_Str  ("   ");
1237                   Write_Line (Ali_Files (Index).all);
1238                end loop;
1239             end if;
1240
1241             Write_Eol;
1242          end if;
1243
1244          --  We check that all object files are regular files
1245
1246          Check_Context;
1247
1248          --  Delete the existing library file, if it exists.
1249          --  Fail if the library file is not writable, or if it is not possible
1250          --  to delete the file.
1251
1252          declare
1253             DLL_Name : aliased String :=
1254                          Lib_Dirpath.all & "/lib" &
1255                            Lib_Filename.all & "." & DLL_Ext;
1256
1257             Archive_Name : aliased String :=
1258                              Lib_Dirpath.all & "/lib" &
1259                                Lib_Filename.all & "." & Archive_Ext;
1260
1261             type Str_Ptr is access all String;
1262             --  This type is necessary to meet the accessibility rules of Ada.
1263             --  It is not possible to use String_Access here.
1264
1265             Full_Lib_Name : Str_Ptr;
1266             --  Designates the full library path name. Either DLL_Name or
1267             --  Archive_Name, depending on the library kind.
1268
1269             Success : Boolean := False;
1270             --  Used to call Delete_File
1271
1272          begin
1273             if The_Build_Mode = Static then
1274                Full_Lib_Name := Archive_Name'Access;
1275             else
1276                Full_Lib_Name := DLL_Name'Access;
1277             end if;
1278
1279             if Is_Regular_File (Full_Lib_Name.all) then
1280                if Is_Writable_File (Full_Lib_Name.all) then
1281                   Delete_File (Full_Lib_Name.all, Success);
1282                end if;
1283
1284                if Is_Regular_File (Full_Lib_Name.all) then
1285                   Com.Fail ("could not delete """ & Full_Lib_Name.all & """");
1286                end if;
1287             end if;
1288          end;
1289
1290          Argument_Number := 0;
1291
1292          --  If we have a standalone library, gather all the interface ALI.
1293          --  They are passed to Build_Dynamic_Library, where they are used by
1294          --  some platforms (VMS, for example) to decide what symbols should be
1295          --  exported. They are also flagged as Interface when we copy them to
1296          --  the library directory (by Copy_ALI_Files, below).
1297
1298          if Standalone then
1299             Data := Projects.Table (For_Project);
1300
1301             declare
1302                Interface : String_List_Id := Data.Lib_Interface_ALIs;
1303                ALI       : File_Name_Type;
1304
1305             begin
1306                while Interface /= Nil_String loop
1307                   ALI := String_Elements.Table (Interface).Value;
1308                   Interface_ALIs.Set (ALI, True);
1309                   Get_Name_String (String_Elements.Table (Interface).Value);
1310                   Add_Argument (Name_Buffer (1 .. Name_Len));
1311                   Interface := String_Elements.Table (Interface).Next;
1312                end loop;
1313
1314                Interface := Data.Lib_Interface_ALIs;
1315
1316                if not Opt.Quiet_Output then
1317
1318                   --  Check that the interface set is complete: any unit in the
1319                   --  library that is needed by an interface should also be an
1320                   --  interface. If it is not the case, output a warning.
1321
1322                   while Interface /= Nil_String loop
1323                      ALI := String_Elements.Table (Interface).Value;
1324                      Process (ALI);
1325                      Interface := String_Elements.Table (Interface).Next;
1326                   end loop;
1327                end if;
1328             end;
1329          end if;
1330
1331          --  Clean the library directory, if it is also the directory where
1332          --  the ALI files are copied, either because there is no interface
1333          --  copy directory or because the interface copy directory is the
1334          --  same as the library directory.
1335
1336          Copy_Dir := Projects.Table (For_Project).Library_Dir;
1337          Clean (Copy_Dir);
1338
1339          --  Call the procedure to build the library, depending on the build
1340          --  mode.
1341
1342          case The_Build_Mode is
1343             when Dynamic | Relocatable =>
1344                Build_Dynamic_Library
1345                  (Ofiles        => Object_Files.all,
1346                   Foreign       => Foreign_Objects.all,
1347                   Afiles        => Ali_Files.all,
1348                   Options       => Options.all,
1349                   Interfaces    => Arguments (1 .. Argument_Number),
1350                   Lib_Filename  => Lib_Filename.all,
1351                   Lib_Dir       => Lib_Dirpath.all,
1352                   Symbol_Data   => Data.Symbol_Data,
1353                   Driver_Name   => Driver_Name,
1354                   Lib_Address   => DLL_Address.all,
1355                   Lib_Version   => Lib_Version.all,
1356                   Relocatable   => The_Build_Mode = Relocatable,
1357                   Auto_Init     => Data.Lib_Auto_Init);
1358
1359             when Static =>
1360                MLib.Build_Library
1361                  (Object_Files.all,
1362                   Ali_Files.all,
1363                   Lib_Filename.all,
1364                   Lib_Dirpath.all);
1365
1366             when None =>
1367                null;
1368          end case;
1369
1370          --  We need to copy the ALI files from the object directory
1371          --  to the library directory, so that the linker find them there,
1372          --  and does not need to look in the object directory where it would
1373          --  also find the object files; and we don't want that: we want the
1374          --  linker to use the library.
1375
1376          --  Copy the ALI files and make the copies read-only. For interfaces,
1377          --  mark the copies as interfaces.
1378
1379          Copy_ALI_Files
1380            (Files      => Ali_Files.all,
1381             To         => Copy_Dir,
1382             Interfaces => Arguments (1 .. Argument_Number));
1383
1384          --  Copy interface sources if Library_Src_Dir specified
1385
1386          if Standalone
1387            and then Projects.Table (For_Project).Library_Src_Dir /= No_Name
1388          then
1389             --  Clean the interface copy directory, if it is not also the
1390             --  library directory. If it is also the library directory, it has
1391             --  already been cleaned before the generation of the library.
1392
1393             if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then
1394                Copy_Dir := Projects.Table (For_Project).Library_Src_Dir;
1395                Clean (Copy_Dir);
1396             end if;
1397
1398             Copy_Interface_Sources
1399               (For_Project => For_Project,
1400                Interfaces => Arguments (1 .. Argument_Number),
1401                To_Dir => Copy_Dir);
1402          end if;
1403       end if;
1404
1405       --  Reset the current working directory to its previous value
1406
1407       Change_Dir (Current_Dir);
1408    end Build_Library;
1409
1410    -----------
1411    -- Check --
1412    -----------
1413
1414    procedure Check (Filename : String) is
1415    begin
1416       if not Is_Regular_File (Filename) then
1417          Com.Fail (Filename, " not found.");
1418       end if;
1419    end Check;
1420
1421    -------------------
1422    -- Check_Context --
1423    -------------------
1424
1425    procedure Check_Context is
1426    begin
1427       --  check that each object file exists
1428
1429       for F in Object_Files'Range loop
1430          Check (Object_Files (F).all);
1431       end loop;
1432    end Check_Context;
1433
1434    -------------------
1435    -- Check_Library --
1436    -------------------
1437
1438    procedure Check_Library (For_Project : Project_Id) is
1439       Data : constant Project_Data := Projects.Table (For_Project);
1440
1441    begin
1442       if Data.Library and not Data.Flag1 then
1443          declare
1444             Current  : constant Dir_Name_Str := Get_Current_Dir;
1445             Lib_Name : constant Name_Id := Library_File_Name_For (For_Project);
1446             Lib_TS   : Time_Stamp_Type;
1447             Obj_TS   : Time_Stamp_Type;
1448
1449             Object_Dir : Dir_Type;
1450
1451          begin
1452             if Hostparm.OpenVMS then
1453                B_Start (B_Start'Last) := '$';
1454             end if;
1455
1456             Change_Dir (Get_Name_String (Data.Library_Dir));
1457
1458             Lib_TS := File_Stamp (Lib_Name);
1459
1460             --  If the library file does not exist, then the time stamp will
1461             --  be Empty_Time_Stamp, earlier than any other time stamp.
1462
1463             Change_Dir (Get_Name_String (Data.Object_Directory));
1464             Open (Dir => Object_Dir, Dir_Name => ".");
1465
1466             --  For all entries in the object directory
1467
1468             loop
1469                Read (Object_Dir, Name_Buffer, Name_Len);
1470                exit when Name_Len = 0;
1471
1472                --  Check if it is an object file, but ignore any binder
1473                --  generated file.
1474
1475                if Is_Obj (Name_Buffer (1 .. Name_Len))
1476                   and then Name_Buffer (1 .. B_Start'Length) /= B_Start
1477                then
1478
1479                   --  Get the object file time stamp
1480
1481                   Obj_TS := File_Stamp (Name_Find);
1482
1483                   --  If library file time stamp is earlier, set Flag1 and
1484                   --  return. String comparaison is used, otherwise time stamps
1485                   --  may be too close and the comparaison would return True,
1486                   --  which would trigger an unnecessary rebuild of the
1487                   --  library.
1488
1489                   if String (Lib_TS) < String (Obj_TS) then
1490
1491                      --  Library must be rebuilt
1492
1493                      Projects.Table (For_Project).Flag1 := True;
1494                      exit;
1495                   end if;
1496                end if;
1497             end loop;
1498
1499             Change_Dir (Current);
1500          end;
1501       end if;
1502    end Check_Library;
1503
1504    -----------
1505    -- Clean --
1506    -----------
1507
1508    procedure Clean (Directory : Name_Id) is
1509       Current  : constant Dir_Name_Str := Get_Current_Dir;
1510
1511       Dir : Dir_Type;
1512
1513       Name : String (1 .. 200);
1514       Last : Natural;
1515
1516       Disregard : Boolean;
1517
1518       procedure Set_Writable (Name : System.Address);
1519       pragma Import (C, Set_Writable, "__gnat_set_writable");
1520
1521    begin
1522       Get_Name_String (Directory);
1523
1524       --  Change the working directory to the directory to clean
1525
1526       begin
1527          Change_Dir (Name_Buffer (1 .. Name_Len));
1528
1529       exception
1530          when others =>
1531             Com.Fail
1532               ("unable to access directory """,
1533                Name_Buffer (1 .. Name_Len),
1534                """");
1535       end;
1536
1537       Open (Dir, ".");
1538
1539       --  For each regular file in the directory, make it writable and
1540       --  delete the file.
1541
1542       loop
1543          Read (Dir, Name, Last);
1544          exit when Last = 0;
1545
1546          if Is_Regular_File (Name (1 .. Last)) then
1547             Name (Last + 1) := ASCII.NUL;
1548             Set_Writable (Name (1)'Address);
1549             Delete_File (Name (1 .. Last), Disregard);
1550          end if;
1551       end loop;
1552
1553       Close (Dir);
1554
1555       --  Restore the initial working directory
1556
1557       Change_Dir (Current);
1558    end Clean;
1559
1560    ----------------------------
1561    -- Copy_Interface_Sources --
1562    ----------------------------
1563
1564    procedure Copy_Interface_Sources
1565      (For_Project : Project_Id;
1566       Interfaces  : Argument_List;
1567       To_Dir      : Name_Id)
1568    is
1569       Current  : constant Dir_Name_Str := Get_Current_Dir;
1570       Target   : constant Dir_Name_Str := Get_Name_String (To_Dir);
1571
1572       Text     : Text_Buffer_Ptr;
1573       The_ALI  : ALI.ALI_Id;
1574       Lib_File : Name_Id;
1575
1576       First_Unit  : ALI.Unit_Id;
1577       Second_Unit : ALI.Unit_Id;
1578
1579       Data : Unit_Data;
1580
1581       Copy_Subunits : Boolean := False;
1582
1583       procedure Copy (File_Name : Name_Id);
1584       --  Copy one source of the project to the target directory
1585
1586       ----------
1587       -- Copy --
1588       ----------
1589
1590       procedure Copy (File_Name : Name_Id) is
1591          Success : Boolean := False;
1592
1593       begin
1594          Unit_Loop :
1595          for Index in 1 .. Com.Units.Last loop
1596             Data := Com.Units.Table (Index);
1597
1598             for J in Data.File_Names'Range loop
1599                if Data.File_Names (J).Project = For_Project
1600                  and then Data.File_Names (J).Name = File_Name
1601                then
1602                   Copy_File
1603                     (Get_Name_String (Data.File_Names (J).Path),
1604                      Target,
1605                      Success,
1606                      Mode => Overwrite,
1607                      Preserve => Preserve);
1608                   exit Unit_Loop;
1609                end if;
1610             end loop;
1611          end loop Unit_Loop;
1612       end Copy;
1613
1614       use ALI;
1615
1616    --  Start of processing for Copy_Interface_Sources
1617
1618    begin
1619       --  Change the working directory to the object directory
1620
1621       Change_Dir
1622         (Get_Name_String (Projects.Table (For_Project).Object_Directory));
1623
1624       for Index in Interfaces'Range loop
1625
1626          --  First, load the ALI file
1627
1628          Name_Len := 0;
1629          Add_Str_To_Name_Buffer (Interfaces (Index).all);
1630          Lib_File := Name_Find;
1631          Text := Read_Library_Info (Lib_File);
1632          The_ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
1633          Free (Text);
1634
1635          Second_Unit := No_Unit_Id;
1636          First_Unit := ALI.ALIs.Table (The_ALI).First_Unit;
1637          Copy_Subunits := True;
1638
1639          --  If there is both a spec and a body, check if they are both needed
1640
1641          if ALI.Units.Table (First_Unit).Utype = Is_Body then
1642             Second_Unit := ALI.ALIs.Table (The_ALI).Last_Unit;
1643
1644             --  If the body is not needed, then reset First_Unit
1645
1646             if not ALI.Units.Table (Second_Unit).Body_Needed_For_SAL then
1647                First_Unit := No_Unit_Id;
1648                Copy_Subunits := False;
1649             end if;
1650
1651          elsif ALI.Units.Table (First_Unit).Utype = Is_Spec_Only then
1652             Copy_Subunits := False;
1653          end if;
1654
1655          --  Copy the file(s) that need to be copied
1656
1657          if First_Unit /= No_Unit_Id then
1658             Copy (File_Name => ALI.Units.Table (First_Unit).Sfile);
1659          end if;
1660
1661          if Second_Unit /= No_Unit_Id then
1662             Copy (File_Name => ALI.Units.Table (Second_Unit).Sfile);
1663          end if;
1664
1665          --  Copy all the separates, if any
1666
1667          if Copy_Subunits then
1668             for Dep in ALI.ALIs.Table (The_ALI).First_Sdep ..
1669               ALI.ALIs.Table (The_ALI).Last_Sdep
1670             loop
1671                if Sdep.Table (Dep).Subunit_Name /= No_Name then
1672                   Copy (File_Name => Sdep.Table (Dep).Sfile);
1673                end if;
1674             end loop;
1675          end if;
1676       end loop;
1677
1678       --  Restore the initial working directory
1679
1680       Change_Dir (Current);
1681    end Copy_Interface_Sources;
1682
1683    -------------
1684    -- Display --
1685    -------------
1686
1687    procedure Display (Executable : String) is
1688    begin
1689       if not Opt.Quiet_Output then
1690          Write_Str (Executable);
1691
1692          for Index in 1 .. Argument_Number loop
1693             Write_Char (' ');
1694             Write_Str (Arguments (Index).all);
1695          end loop;
1696
1697          Write_Eol;
1698       end if;
1699    end Display;
1700
1701    -------------------------
1702    -- Process_Binder_File --
1703    -------------------------
1704
1705    procedure Process_Binder_File (Name : String) is
1706       Fd : FILEs;
1707       --  Binder file's descriptor
1708
1709       Read_Mode  : constant String := "r" & ASCII.Nul;
1710       --  For fopen
1711
1712       Status : Interfaces.C_Streams.int;
1713       --  For fclose
1714
1715       Begin_Info : String := "--  BEGIN Object file/option list";
1716       End_Info   : String := "--  END Object file/option list   ";
1717
1718       Next_Line : String (1 .. 1000);
1719       --  Current line value
1720       --  Where does this odd constant 1000 come from, looks suspicious ???
1721
1722       Nlast : Integer;
1723       --  End of line slice (the slice does not contain the line terminator)
1724
1725       procedure Get_Next_Line;
1726       --  Read the next line from the binder file without the line terminator
1727
1728       -------------------
1729       -- Get_Next_Line --
1730       -------------------
1731
1732       procedure Get_Next_Line is
1733          Fchars : chars;
1734
1735       begin
1736          Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
1737
1738          if Fchars = System.Null_Address then
1739             Fail ("Error reading binder output");
1740          end if;
1741
1742          Nlast := 1;
1743          while Nlast <= Next_Line'Last
1744            and then Next_Line (Nlast) /= ASCII.LF
1745            and then Next_Line (Nlast) /= ASCII.CR
1746          loop
1747             Nlast := Nlast + 1;
1748          end loop;
1749
1750          Nlast := Nlast - 1;
1751       end Get_Next_Line;
1752
1753    --  Start of processing for Process_Binder_File
1754
1755    begin
1756       Fd := fopen (Name'Address, Read_Mode'Address);
1757
1758       if Fd = NULL_Stream then
1759          Fail ("Failed to open binder output");
1760       end if;
1761
1762       --  Skip up to the Begin Info line
1763
1764       loop
1765          Get_Next_Line;
1766          exit when Next_Line (1 .. Nlast) = Begin_Info;
1767       end loop;
1768
1769       --  Find the first switch
1770
1771       loop
1772          Get_Next_Line;
1773
1774          exit when Next_Line (1 .. Nlast) = End_Info;
1775
1776          --  As the binder generated file is in Ada, remove the first eight
1777          --  characters "   --   ".
1778
1779          Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
1780          Nlast := Nlast - 8;
1781
1782          --  Stop when the first switch is found
1783
1784          exit when Next_Line (1) = '-';
1785       end loop;
1786
1787       if Next_Line (1 .. Nlast) /= End_Info then
1788          loop
1789             --  Disregard -static and -shared, as -shared will be used
1790             --  in any case.
1791
1792             --  Disregard -lgnat, -lgnarl and -ldecgnat as they will be added
1793             --  later, because they are also needed for non Stand-Alone shared
1794             --  libraries.
1795
1796             if Next_Line (1 .. Nlast) /= "-static" and then
1797                Next_Line (1 .. Nlast) /= "-shared" and then
1798                Next_Line (1 .. Nlast) /= "-ldecgnat" and then
1799                Next_Line (1 .. Nlast) /= "-lgnarl" and then
1800                Next_Line (1 .. Nlast) /= "-lgnat"
1801             then
1802                if Next_Line (1) /= '-' then
1803
1804                   --  This is not an option, should we add it?
1805
1806                   if Add_Object_Files then
1807                      Opts.Increment_Last;
1808                      Opts.Table (Opts.Last) :=
1809                        new String'(Next_Line (1 .. Nlast));
1810                   end if;
1811
1812                else
1813                   --  Add all other options
1814
1815                   Opts.Increment_Last;
1816                   Opts.Table (Opts.Last) :=
1817                     new String'(Next_Line (1 .. Nlast));
1818                end if;
1819             end if;
1820
1821             --  Next option, if any
1822
1823             Get_Next_Line;
1824             exit when Next_Line (1 .. Nlast) = End_Info;
1825
1826             --  Remove first eight characters "   --   "
1827
1828             Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
1829             Nlast := Nlast - 8;
1830          end loop;
1831       end if;
1832
1833       Status := fclose (Fd);
1834    end Process_Binder_File;
1835
1836    ------------------
1837    -- Reset_Tables --
1838    ------------------
1839
1840    procedure Reset_Tables is
1841    begin
1842       Objects.Init;
1843       Objects_Htable.Reset;
1844       Foreigns.Init;
1845       ALIs.Init;
1846       Opts.Init;
1847       Processed_Projects.Reset;
1848       Library_Projs.Init;
1849    end Reset_Tables;
1850
1851 end MLib.Prj;