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 Afile /= No_Name and then 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
 818             begin
 819                if Binder_Package /= No_Package then
 820                   declare
 821                      Defaults : constant Array_Element_Id :=
 822                                   Value_Of
 823                                     (Name      => Name_Default_Switches,
 824                                      In_Arrays =>
 825                                        Packages.Table
 826                                          (Binder_Package).Decl.Arrays);
 827                      Switches : Variable_Value := Nil_Variable_Value;
 828
 829                      Switch : String_List_Id := Nil_String;
 830
 831                   begin
 832                      if Defaults /= No_Array_Element then
 833                         Switches :=
 834                           Value_Of
 835                             (Index => Name_Ada, In_Array => Defaults);
 836
 837                         if not Switches.Default then
 838                            Switch := Switches.Values;
 839
 840                            while Switch /= Nil_String loop
 841                               Add_Argument
 842                                 (Get_Name_String
 843                                    (String_Elements.Table (Switch).Value));
 844                               Switch := String_Elements.Table (Switch).Next;
 845                            end loop;
 846                         end if;
 847                      end if;
 848                   end;
 849                end if;
 850             end;
 851
 852             --  Get all the ALI files of the project file
 853
 854             declare
 855                Unit : Unit_Data;
 856
 857             begin
 858                Library_ALIs.Reset;
 859                Interface_ALIs.Reset;
 860                Processed_ALIs.Reset;
 861                for Source in 1 .. Com.Units.Last loop
 862                   Unit := Com.Units.Table (Source);
 863
 864                   if Unit.File_Names (Body_Part).Name /= No_Name
 865                     and then Unit.File_Names (Body_Part).Path /= Slash
 866                   then
 867                      if
 868                        Check_Project (Unit.File_Names (Body_Part).Project)
 869                      then
 870                         if Unit.File_Names (Specification).Name = No_Name then
 871                            declare
 872                               Src_Ind : Source_File_Index;
 873
 874                            begin
 875                               Src_Ind := Sinput.P.Load_Project_File
 876                                 (Get_Name_String
 877                                    (Unit.File_Names
 878                                       (Body_Part).Path));
 879
 880                               --  Add the ALI file only if it is not a subunit
 881
 882                               if
 883                               not Sinput.P.Source_File_Is_Subunit (Src_Ind)
 884                               then
 885                                  Add_ALI_For
 886                                    (Unit.File_Names (Body_Part).Name);
 887                               end if;
 888                            end;
 889
 890                         else
 891                            Add_ALI_For (Unit.File_Names (Body_Part).Name);
 892                         end if;
 893                      end if;
 894
 895                   elsif Unit.File_Names (Specification).Name /= No_Name
 896                     and then Unit.File_Names (Specification).Path /= Slash
 897                     and then Check_Project
 898                       (Unit.File_Names (Specification).Project)
 899                   then
 900                      Add_ALI_For (Unit.File_Names (Specification).Name);
 901                   end if;
 902                end loop;
 903             end;
 904
 905             --  Set the paths
 906
 907             Set_Ada_Paths
 908               (Project => For_Project, Including_Libraries => True);
 909
 910             --  Display the gnatbind command, if not in quiet output
 911
 912             Display (Gnatbind);
 913
 914             --  Invoke gnatbind
 915
 916             GNAT.OS_Lib.Spawn
 917               (Gnatbind_Path.all, Arguments (1 .. Argument_Number), Success);
 918
 919             if not Success then
 920                Com.Fail ("could not bind standalone library ",
 921                          Get_Name_String (Data.Library_Name));
 922             end if;
 923
 924          end if;
 925
 926          --  Compile the binder generated file only if Link is true
 927
 928          if Link then
 929             --  Set the paths
 930
 931             Set_Ada_Paths
 932               (Project => For_Project, Including_Libraries => True);
 933
 934             --  Invoke <gcc> -c b$$<lib>.adb
 935
 936             --  Allocate Arguments, if it is the first time we see a standalone
 937             --  library.
 938
 939             if Arguments = No_Argument then
 940                Arguments := new String_List (1 .. Initial_Argument_Max);
 941             end if;
 942
 943             Argument_Number := 1;
 944             Arguments (1) := Compile_Switch;
 945
 946             if Hostparm.OpenVMS then
 947                B_Start (B_Start'Last) := '$';
 948             end if;
 949
 950             Add_Argument
 951               (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
 952
 953             --  If necessary, add the PIC option
 954
 955             if PIC_Option /= "" then
 956                Add_Argument (PIC_Option);
 957             end if;
 958
 959             Display (Gcc);
 960             GNAT.OS_Lib.Spawn
 961               (Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
 962
 963             if not Success then
 964                Com.Fail
 965                  ("could not compile binder generated file for library ",
 966                   Get_Name_String (Data.Library_Name));
 967             end if;
 968
 969             --  Process binder generated file for pragmas Linker_Options
 970
 971             Process_Binder_File (Arguments (2).all & ASCII.NUL);
 972          end if;
 973       end if;
 974
 975       --  Build the library only if Link is True
 976
 977       if Link then
 978          --  If attribute Library_GCC was specified, get the driver name
 979
 980          Library_GCC := Value_Of (Name_Library_GCC, Data.Decl.Attributes);
 981
 982          if not Library_GCC.Default then
 983             Driver_Name := Library_GCC.Value;
 984          end if;
 985
 986          --  If attribute Library_Options was specified, add these additional
 987          --  options.
 988
 989          Library_Options :=
 990            Value_Of (Name_Library_Options, Data.Decl.Attributes);
 991
 992          if not Library_Options.Default then
 993             declare
 994                Current : String_List_Id := Library_Options.Values;
 995                Element : String_Element;
 996
 997             begin
 998                while Current /= Nil_String loop
 999                   Element := String_Elements.Table (Current);
1000                   Get_Name_String (Element.Value);
1001
1002                   if Name_Len /= 0 then
1003                      Opts.Increment_Last;
1004                      Opts.Table (Opts.Last) :=
1005                        new String'(Name_Buffer (1 .. Name_Len));
1006                   end if;
1007
1008                   Current := Element.Next;
1009                end loop;
1010             end;
1011          end if;
1012
1013          Lib_Dirpath  := new String'(Get_Name_String (Data.Library_Dir));
1014          Lib_Filename := new String'(Get_Name_String (Data.Library_Name));
1015
1016          case Data.Library_Kind is
1017             when Static =>
1018                The_Build_Mode := Static;
1019
1020             when Dynamic =>
1021                The_Build_Mode := Dynamic;
1022
1023             when Relocatable =>
1024                The_Build_Mode := Relocatable;
1025
1026                if PIC_Option /= "" then
1027                   Opts.Increment_Last;
1028                   Opts.Table (Opts.Last) := new String'(PIC_Option);
1029                end if;
1030          end case;
1031
1032          --  Get the library version, if any
1033
1034          if Data.Lib_Internal_Name /= No_Name then
1035             Lib_Version :=
1036               new String'(Get_Name_String (Data.Lib_Internal_Name));
1037          end if;
1038
1039          --  Add the objects found in the object directory and the object
1040          --  directories of the extended files, if any, except for generated
1041          --  object files (b~.. or B$..) from extended projects.
1042          --  When there are one or more extended files, only add an object file
1043          --  if no object file with the same name have already been added.
1044
1045          In_Main_Object_Directory := True;
1046
1047          loop
1048             declare
1049                Object_Dir_Path : constant String :=
1050                                    Get_Name_String (Data.Object_Directory);
1051                Object_Dir      : Dir_Type;
1052                Filename        : String (1 .. 255);
1053                Last            : Natural;
1054                Id              : Name_Id;
1055
1056             begin
1057                Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path);
1058
1059                --  For all entries in the object directory
1060
1061                loop
1062                   Read (Object_Dir, Filename, Last);
1063
1064                   exit when Last = 0;
1065
1066                   --  Check if it is an object file
1067
1068                   if Is_Obj (Filename (1 .. Last)) then
1069                      declare
1070                         Object_Path : String :=
1071                           Normalize_Pathname
1072                             (Object_Dir_Path & Directory_Separator &
1073                              Filename (1 .. Last));
1074
1075                      begin
1076                         Canonical_Case_File_Name (Object_Path);
1077                         Canonical_Case_File_Name (Filename (1 .. Last));
1078
1079                         --  If in the object directory of an extended project,
1080                         --  do not consider generated object files.
1081
1082                         if In_Main_Object_Directory or else
1083                           Last < 5 or else
1084                           Filename (1 .. B_Start'Length) /= B_Start
1085                         then
1086                            Name_Len := Last;
1087                            Name_Buffer (1 .. Name_Len) := Filename (1 .. Last);
1088                            Id := Name_Find;
1089
1090                            if not Objects_Htable.Get (Id) then
1091
1092                               --  Record this object file
1093
1094                               Objects_Htable.Set (Id, True);
1095                               Objects.Increment_Last;
1096                               Objects.Table (Objects.Last) :=
1097                                 new String'(Object_Path);
1098
1099                               declare
1100                                  ALI_File : constant String :=
1101                                               Ext_To (Object_Path, "ali");
1102
1103                               begin
1104                                  if Is_Regular_File (ALI_File) then
1105
1106                                     --  Record the ALI file
1107
1108                                     ALIs.Increment_Last;
1109                                     ALIs.Table (ALIs.Last) :=
1110                                       new String'(ALI_File);
1111
1112                                     --  Find out if for this ALI file,
1113                                     --  libgnarl or libdecgnat (on OpenVMS)
1114                                     --  is necessary.
1115
1116                                     Check_Libs (ALI_File);
1117
1118                                  else
1119                                     --  The object file is a foreign object
1120                                     --  file.
1121
1122                                     Foreigns.Increment_Last;
1123                                     Foreigns.Table (Foreigns.Last) :=
1124                                       new String'(Object_Path);
1125                                  end if;
1126                               end;
1127                            end if;
1128                         end if;
1129                      end;
1130                   end if;
1131                end loop;
1132
1133                Close (Dir => Object_Dir);
1134
1135             exception
1136                when Directory_Error =>
1137                   Com.Fail ("cannot find object directory """,
1138                             Get_Name_String (Data.Object_Directory),
1139                             """");
1140             end;
1141
1142             exit when Data.Extends = No_Project;
1143
1144             In_Main_Object_Directory  := False;
1145             Data := Projects.Table (Data.Extends);
1146          end loop;
1147
1148          --  Add the -L and -l switches for the imported Library Project Files,
1149          --  and, if Path Option is supported, the library directory path names
1150          --  to Rpath.
1151
1152          Process_Imported_Libraries;
1153
1154          --  Link with libgnat and possibly libgnarl
1155
1156          Opts.Increment_Last;
1157          Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory);
1158
1159          --  If Path Option is supported, add libgnat directory path name to
1160          --  Rpath.
1161
1162          if Path_Option /= null then
1163             Add_Rpath (Lib_Directory);
1164          end if;
1165
1166          if Libgnarl_Needed then
1167             Opts.Increment_Last;
1168             Opts.Table (Opts.Last) := new String'("-lgnarl");
1169          end if;
1170
1171          if Libdecgnat_Needed then
1172             Opts.Increment_Last;
1173             Opts.Table (Opts.Last) :=
1174               new String'("-L" & Lib_Directory & "/../declib");
1175             Opts.Increment_Last;
1176             Opts.Table (Opts.Last) := new String'("-ldecgnat");
1177          end if;
1178
1179          Opts.Increment_Last;
1180          Opts.Table (Opts.Last) := new String'("-lgnat");
1181
1182          --  If Path Option is supported, add the necessary switch with the
1183          --  content of Rpath. As Rpath contains at least libgnat directory
1184          --  path name, it is guaranteed that it is not null.
1185
1186          if Path_Option /= null then
1187             Opts.Increment_Last;
1188             Opts.Table (Opts.Last) :=
1189               new String'(Path_Option.all & Rpath (1 .. Rpath_Last));
1190             Free (Path_Option);
1191             Free (Rpath);
1192          end if;
1193
1194          Object_Files :=
1195            new Argument_List'
1196              (Argument_List (Objects.Table (1 .. Objects.Last)));
1197
1198          Foreign_Objects :=
1199            new Argument_List'(Argument_List
1200                                 (Foreigns.Table (1 .. Foreigns.Last)));
1201
1202          Ali_Files :=
1203            new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
1204
1205          Options :=
1206            new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
1207
1208          --  We fail if there are no object to put in the library
1209          --  (Ada or foreign objects).
1210
1211          if Object_Files'Length = 0 then
1212             Com.Fail ("no object files for library """ &
1213                       Lib_Filename.all & '"');
1214
1215          end if;
1216
1217          if not Opt.Quiet_Output then
1218             Write_Eol;
1219             Write_Str  ("building ");
1220             Write_Str (Ada.Characters.Handling.To_Lower
1221                          (Build_Mode_State'Image (The_Build_Mode)));
1222             Write_Str  (" library for project ");
1223             Write_Line (Project_Name);
1224
1225             Write_Eol;
1226
1227             Write_Line ("object files:");
1228
1229             for Index in Object_Files'Range loop
1230                Write_Str  ("   ");
1231                Write_Line (Object_Files (Index).all);
1232             end loop;
1233
1234             Write_Eol;
1235
1236             if Ali_Files'Length = 0 then
1237                Write_Line ("NO ALI files");
1238
1239             else
1240                Write_Line ("ALI files:");
1241
1242                for Index in Ali_Files'Range loop
1243                   Write_Str  ("   ");
1244                   Write_Line (Ali_Files (Index).all);
1245                end loop;
1246             end if;
1247
1248             Write_Eol;
1249          end if;
1250
1251          --  We check that all object files are regular files
1252
1253          Check_Context;
1254
1255          --  Delete the existing library file, if it exists.
1256          --  Fail if the library file is not writable, or if it is not possible
1257          --  to delete the file.
1258
1259          declare
1260             DLL_Name : aliased String :=
1261                          Lib_Dirpath.all & "/lib" &
1262                            Lib_Filename.all & "." & DLL_Ext;
1263
1264             Archive_Name : aliased String :=
1265                              Lib_Dirpath.all & "/lib" &
1266                                Lib_Filename.all & "." & Archive_Ext;
1267
1268             type Str_Ptr is access all String;
1269             --  This type is necessary to meet the accessibility rules of Ada.
1270             --  It is not possible to use String_Access here.
1271
1272             Full_Lib_Name : Str_Ptr;
1273             --  Designates the full library path name. Either DLL_Name or
1274             --  Archive_Name, depending on the library kind.
1275
1276             Success : Boolean := False;
1277             --  Used to call Delete_File
1278
1279          begin
1280             if The_Build_Mode = Static then
1281                Full_Lib_Name := Archive_Name'Access;
1282             else
1283                Full_Lib_Name := DLL_Name'Access;
1284             end if;
1285
1286             if Is_Regular_File (Full_Lib_Name.all) then
1287                if Is_Writable_File (Full_Lib_Name.all) then
1288                   Delete_File (Full_Lib_Name.all, Success);
1289                end if;
1290
1291                if Is_Regular_File (Full_Lib_Name.all) then
1292                   Com.Fail ("could not delete """ & Full_Lib_Name.all & """");
1293                end if;
1294             end if;
1295          end;
1296
1297          Argument_Number := 0;
1298
1299          --  If we have a standalone library, gather all the interface ALI.
1300          --  They are passed to Build_Dynamic_Library, where they are used by
1301          --  some platforms (VMS, for example) to decide what symbols should be
1302          --  exported. They are also flagged as Interface when we copy them to
1303          --  the library directory (by Copy_ALI_Files, below).
1304
1305          if Standalone then
1306             Data := Projects.Table (For_Project);
1307
1308             declare
1309                Interface : String_List_Id := Data.Lib_Interface_ALIs;
1310                ALI       : File_Name_Type;
1311
1312             begin
1313                while Interface /= Nil_String loop
1314                   ALI := String_Elements.Table (Interface).Value;
1315                   Interface_ALIs.Set (ALI, True);
1316                   Get_Name_String (String_Elements.Table (Interface).Value);
1317                   Add_Argument (Name_Buffer (1 .. Name_Len));
1318                   Interface := String_Elements.Table (Interface).Next;
1319                end loop;
1320
1321                Interface := Data.Lib_Interface_ALIs;
1322
1323                if not Opt.Quiet_Output then
1324
1325                   --  Check that the interface set is complete: any unit in the
1326                   --  library that is needed by an interface should also be an
1327                   --  interface. If it is not the case, output a warning.
1328
1329                   while Interface /= Nil_String loop
1330                      ALI := String_Elements.Table (Interface).Value;
1331                      Process (ALI);
1332                      Interface := String_Elements.Table (Interface).Next;
1333                   end loop;
1334                end if;
1335             end;
1336          end if;
1337
1338          --  Clean the library directory, if it is also the directory where
1339          --  the ALI files are copied, either because there is no interface
1340          --  copy directory or because the interface copy directory is the
1341          --  same as the library directory.
1342
1343          Copy_Dir := Projects.Table (For_Project).Library_Dir;
1344          Clean (Copy_Dir);
1345
1346          --  Call the procedure to build the library, depending on the build
1347          --  mode.
1348
1349          case The_Build_Mode is
1350             when Dynamic | Relocatable =>
1351                Build_Dynamic_Library
1352                  (Ofiles        => Object_Files.all,
1353                   Foreign       => Foreign_Objects.all,
1354                   Afiles        => Ali_Files.all,
1355                   Options       => Options.all,
1356                   Interfaces    => Arguments (1 .. Argument_Number),
1357                   Lib_Filename  => Lib_Filename.all,
1358                   Lib_Dir       => Lib_Dirpath.all,
1359                   Symbol_Data   => Data.Symbol_Data,
1360                   Driver_Name   => Driver_Name,
1361                   Lib_Address   => DLL_Address.all,
1362                   Lib_Version   => Lib_Version.all,
1363                   Relocatable   => The_Build_Mode = Relocatable,
1364                   Auto_Init     => Data.Lib_Auto_Init);
1365
1366             when Static =>
1367                MLib.Build_Library
1368                  (Object_Files.all,
1369                   Ali_Files.all,
1370                   Lib_Filename.all,
1371                   Lib_Dirpath.all);
1372
1373             when None =>
1374                null;
1375          end case;
1376
1377          --  We need to copy the ALI files from the object directory
1378          --  to the library directory, so that the linker find them there,
1379          --  and does not need to look in the object directory where it would
1380          --  also find the object files; and we don't want that: we want the
1381          --  linker to use the library.
1382
1383          --  Copy the ALI files and make the copies read-only. For interfaces,
1384          --  mark the copies as interfaces.
1385
1386          Copy_ALI_Files
1387            (Files      => Ali_Files.all,
1388             To         => Copy_Dir,
1389             Interfaces => Arguments (1 .. Argument_Number));
1390
1391          --  Copy interface sources if Library_Src_Dir specified
1392
1393          if Standalone
1394            and then Projects.Table (For_Project).Library_Src_Dir /= No_Name
1395          then
1396             --  Clean the interface copy directory, if it is not also the
1397             --  library directory. If it is also the library directory, it has
1398             --  already been cleaned before the generation of the library.
1399
1400             if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then
1401                Copy_Dir := Projects.Table (For_Project).Library_Src_Dir;
1402                Clean (Copy_Dir);
1403             end if;
1404
1405             Copy_Interface_Sources
1406               (For_Project => For_Project,
1407                Interfaces => Arguments (1 .. Argument_Number),
1408                To_Dir => Copy_Dir);
1409          end if;
1410       end if;
1411
1412       --  Reset the current working directory to its previous value
1413
1414       Change_Dir (Current_Dir);
1415    end Build_Library;
1416
1417    -----------
1418    -- Check --
1419    -----------
1420
1421    procedure Check (Filename : String) is
1422    begin
1423       if not Is_Regular_File (Filename) then
1424          Com.Fail (Filename, " not found.");
1425       end if;
1426    end Check;
1427
1428    -------------------
1429    -- Check_Context --
1430    -------------------
1431
1432    procedure Check_Context is
1433    begin
1434       --  check that each object file exists
1435
1436       for F in Object_Files'Range loop
1437          Check (Object_Files (F).all);
1438       end loop;
1439    end Check_Context;
1440
1441    -------------------
1442    -- Check_Library --
1443    -------------------
1444
1445    procedure Check_Library (For_Project : Project_Id) is
1446       Data : constant Project_Data := Projects.Table (For_Project);
1447
1448    begin
1449       if Data.Library and not Data.Flag1 then
1450          declare
1451             Current  : constant Dir_Name_Str := Get_Current_Dir;
1452             Lib_Name : constant Name_Id := Library_File_Name_For (For_Project);
1453             Lib_TS   : Time_Stamp_Type;
1454             Obj_TS   : Time_Stamp_Type;
1455
1456             Object_Dir : Dir_Type;
1457
1458          begin
1459             if Hostparm.OpenVMS then
1460                B_Start (B_Start'Last) := '$';
1461             end if;
1462
1463             Change_Dir (Get_Name_String (Data.Library_Dir));
1464
1465             Lib_TS := File_Stamp (Lib_Name);
1466
1467             --  If the library file does not exist, then the time stamp will
1468             --  be Empty_Time_Stamp, earlier than any other time stamp.
1469
1470             Change_Dir (Get_Name_String (Data.Object_Directory));
1471             Open (Dir => Object_Dir, Dir_Name => ".");
1472
1473             --  For all entries in the object directory
1474
1475             loop
1476                Read (Object_Dir, Name_Buffer, Name_Len);
1477                exit when Name_Len = 0;
1478
1479                --  Check if it is an object file, but ignore any binder
1480                --  generated file.
1481
1482                if Is_Obj (Name_Buffer (1 .. Name_Len))
1483                   and then Name_Buffer (1 .. B_Start'Length) /= B_Start
1484                then
1485
1486                   --  Get the object file time stamp
1487
1488                   Obj_TS := File_Stamp (Name_Find);
1489
1490                   --  If library file time stamp is earlier, set Flag1 and
1491                   --  return. String comparaison is used, otherwise time stamps
1492                   --  may be too close and the comparaison would return True,
1493                   --  which would trigger an unnecessary rebuild of the
1494                   --  library.
1495
1496                   if String (Lib_TS) < String (Obj_TS) then
1497
1498                      --  Library must be rebuilt
1499
1500                      Projects.Table (For_Project).Flag1 := True;
1501                      exit;
1502                   end if;
1503                end if;
1504             end loop;
1505
1506             Change_Dir (Current);
1507          end;
1508       end if;
1509    end Check_Library;
1510
1511    -----------
1512    -- Clean --
1513    -----------
1514
1515    procedure Clean (Directory : Name_Id) is
1516       Current  : constant Dir_Name_Str := Get_Current_Dir;
1517
1518       Dir : Dir_Type;
1519
1520       Name : String (1 .. 200);
1521       Last : Natural;
1522
1523       Disregard : Boolean;
1524
1525       procedure Set_Writable (Name : System.Address);
1526       pragma Import (C, Set_Writable, "__gnat_set_writable");
1527
1528    begin
1529       Get_Name_String (Directory);
1530
1531       --  Change the working directory to the directory to clean
1532
1533       begin
1534          Change_Dir (Name_Buffer (1 .. Name_Len));
1535
1536       exception
1537          when others =>
1538             Com.Fail
1539               ("unable to access directory """,
1540                Name_Buffer (1 .. Name_Len),
1541                """");
1542       end;
1543
1544       Open (Dir, ".");
1545
1546       --  For each regular file in the directory, make it writable and
1547       --  delete the file.
1548
1549       loop
1550          Read (Dir, Name, Last);
1551          exit when Last = 0;
1552
1553          if Is_Regular_File (Name (1 .. Last)) then
1554             Name (Last + 1) := ASCII.NUL;
1555             Set_Writable (Name (1)'Address);
1556             Delete_File (Name (1 .. Last), Disregard);
1557          end if;
1558       end loop;
1559
1560       Close (Dir);
1561
1562       --  Restore the initial working directory
1563
1564       Change_Dir (Current);
1565    end Clean;
1566
1567    ----------------------------
1568    -- Copy_Interface_Sources --
1569    ----------------------------
1570
1571    procedure Copy_Interface_Sources
1572      (For_Project : Project_Id;
1573       Interfaces  : Argument_List;
1574       To_Dir      : Name_Id)
1575    is
1576       Current  : constant Dir_Name_Str := Get_Current_Dir;
1577       Target   : constant Dir_Name_Str := Get_Name_String (To_Dir);
1578
1579       Text     : Text_Buffer_Ptr;
1580       The_ALI  : ALI.ALI_Id;
1581       Lib_File : Name_Id;
1582
1583       First_Unit  : ALI.Unit_Id;
1584       Second_Unit : ALI.Unit_Id;
1585
1586       Data : Unit_Data;
1587
1588       Copy_Subunits : Boolean := False;
1589
1590       procedure Copy (File_Name : Name_Id);
1591       --  Copy one source of the project to the target directory
1592
1593       ----------
1594       -- Copy --
1595       ----------
1596
1597       procedure Copy (File_Name : Name_Id) is
1598          Success : Boolean := False;
1599
1600       begin
1601          Unit_Loop :
1602          for Index in 1 .. Com.Units.Last loop
1603             Data := Com.Units.Table (Index);
1604
1605             for J in Data.File_Names'Range loop
1606                if Data.File_Names (J).Project = For_Project
1607                  and then Data.File_Names (J).Name = File_Name
1608                then
1609                   Copy_File
1610                     (Get_Name_String (Data.File_Names (J).Path),
1611                      Target,
1612                      Success,
1613                      Mode => Overwrite,
1614                      Preserve => Preserve);
1615                   exit Unit_Loop;
1616                end if;
1617             end loop;
1618          end loop Unit_Loop;
1619       end Copy;
1620
1621       use ALI;
1622
1623    --  Start of processing for Copy_Interface_Sources
1624
1625    begin
1626       --  Change the working directory to the object directory
1627
1628       Change_Dir
1629         (Get_Name_String (Projects.Table (For_Project).Object_Directory));
1630
1631       for Index in Interfaces'Range loop
1632
1633          --  First, load the ALI file
1634
1635          Name_Len := 0;
1636          Add_Str_To_Name_Buffer (Interfaces (Index).all);
1637          Lib_File := Name_Find;
1638          Text := Read_Library_Info (Lib_File);
1639          The_ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
1640          Free (Text);
1641
1642          Second_Unit := No_Unit_Id;
1643          First_Unit := ALI.ALIs.Table (The_ALI).First_Unit;
1644          Copy_Subunits := True;
1645
1646          --  If there is both a spec and a body, check if they are both needed
1647
1648          if ALI.Units.Table (First_Unit).Utype = Is_Body then
1649             Second_Unit := ALI.ALIs.Table (The_ALI).Last_Unit;
1650
1651             --  If the body is not needed, then reset First_Unit
1652
1653             if not ALI.Units.Table (Second_Unit).Body_Needed_For_SAL then
1654                First_Unit := No_Unit_Id;
1655                Copy_Subunits := False;
1656             end if;
1657
1658          elsif ALI.Units.Table (First_Unit).Utype = Is_Spec_Only then
1659             Copy_Subunits := False;
1660          end if;
1661
1662          --  Copy the file(s) that need to be copied
1663
1664          if First_Unit /= No_Unit_Id then
1665             Copy (File_Name => ALI.Units.Table (First_Unit).Sfile);
1666          end if;
1667
1668          if Second_Unit /= No_Unit_Id then
1669             Copy (File_Name => ALI.Units.Table (Second_Unit).Sfile);
1670          end if;
1671
1672          --  Copy all the separates, if any
1673
1674          if Copy_Subunits then
1675             for Dep in ALI.ALIs.Table (The_ALI).First_Sdep ..
1676               ALI.ALIs.Table (The_ALI).Last_Sdep
1677             loop
1678                if Sdep.Table (Dep).Subunit_Name /= No_Name then
1679                   Copy (File_Name => Sdep.Table (Dep).Sfile);
1680                end if;
1681             end loop;
1682          end if;
1683       end loop;
1684
1685       --  Restore the initial working directory
1686
1687       Change_Dir (Current);
1688    end Copy_Interface_Sources;
1689
1690    -------------
1691    -- Display --
1692    -------------
1693
1694    procedure Display (Executable : String) is
1695    begin
1696       if not Opt.Quiet_Output then
1697          Write_Str (Executable);
1698
1699          for Index in 1 .. Argument_Number loop
1700             Write_Char (' ');
1701             Write_Str (Arguments (Index).all);
1702          end loop;
1703
1704          Write_Eol;
1705       end if;
1706    end Display;
1707
1708    -------------------------
1709    -- Process_Binder_File --
1710    -------------------------
1711
1712    procedure Process_Binder_File (Name : String) is
1713       Fd : FILEs;
1714       --  Binder file's descriptor
1715
1716       Read_Mode  : constant String := "r" & ASCII.Nul;
1717       --  For fopen
1718
1719       Status : Interfaces.C_Streams.int;
1720       --  For fclose
1721
1722       Begin_Info : String := "--  BEGIN Object file/option list";
1723       End_Info   : String := "--  END Object file/option list   ";
1724
1725       Next_Line : String (1 .. 1000);
1726       --  Current line value
1727       --  Where does this odd constant 1000 come from, looks suspicious ???
1728
1729       Nlast : Integer;
1730       --  End of line slice (the slice does not contain the line terminator)
1731
1732       procedure Get_Next_Line;
1733       --  Read the next line from the binder file without the line terminator
1734
1735       -------------------
1736       -- Get_Next_Line --
1737       -------------------
1738
1739       procedure Get_Next_Line is
1740          Fchars : chars;
1741
1742       begin
1743          Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
1744
1745          if Fchars = System.Null_Address then
1746             Fail ("Error reading binder output");
1747          end if;
1748
1749          Nlast := 1;
1750          while Nlast <= Next_Line'Last
1751            and then Next_Line (Nlast) /= ASCII.LF
1752            and then Next_Line (Nlast) /= ASCII.CR
1753          loop
1754             Nlast := Nlast + 1;
1755          end loop;
1756
1757          Nlast := Nlast - 1;
1758       end Get_Next_Line;
1759
1760    --  Start of processing for Process_Binder_File
1761
1762    begin
1763       Fd := fopen (Name'Address, Read_Mode'Address);
1764
1765       if Fd = NULL_Stream then
1766          Fail ("Failed to open binder output");
1767       end if;
1768
1769       --  Skip up to the Begin Info line
1770
1771       loop
1772          Get_Next_Line;
1773          exit when Next_Line (1 .. Nlast) = Begin_Info;
1774       end loop;
1775
1776       --  Find the first switch
1777
1778       loop
1779          Get_Next_Line;
1780
1781          exit when Next_Line (1 .. Nlast) = End_Info;
1782
1783          --  As the binder generated file is in Ada, remove the first eight
1784          --  characters "   --   ".
1785
1786          Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
1787          Nlast := Nlast - 8;
1788
1789          --  Stop when the first switch is found
1790
1791          exit when Next_Line (1) = '-';
1792       end loop;
1793
1794       if Next_Line (1 .. Nlast) /= End_Info then
1795          loop
1796             --  Disregard -static and -shared, as -shared will be used
1797             --  in any case.
1798
1799             --  Disregard -lgnat, -lgnarl and -ldecgnat as they will be added
1800             --  later, because they are also needed for non Stand-Alone shared
1801             --  libraries.
1802
1803             if Next_Line (1 .. Nlast) /= "-static" and then
1804                Next_Line (1 .. Nlast) /= "-shared" and then
1805                Next_Line (1 .. Nlast) /= "-ldecgnat" and then
1806                Next_Line (1 .. Nlast) /= "-lgnarl" and then
1807                Next_Line (1 .. Nlast) /= "-lgnat"
1808             then
1809                if Next_Line (1) /= '-' then
1810
1811                   --  This is not an option, should we add it?
1812
1813                   if Add_Object_Files then
1814                      Opts.Increment_Last;
1815                      Opts.Table (Opts.Last) :=
1816                        new String'(Next_Line (1 .. Nlast));
1817                   end if;
1818
1819                else
1820                   --  Add all other options
1821
1822                   Opts.Increment_Last;
1823                   Opts.Table (Opts.Last) :=
1824                     new String'(Next_Line (1 .. Nlast));
1825                end if;
1826             end if;
1827
1828             --  Next option, if any
1829
1830             Get_Next_Line;
1831             exit when Next_Line (1 .. Nlast) = End_Info;
1832
1833             --  Remove first eight characters "   --   "
1834
1835             Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
1836             Nlast := Nlast - 8;
1837          end loop;
1838       end if;
1839
1840       Status := fclose (Fd);
1841    end Process_Binder_File;
1842
1843    ------------------
1844    -- Reset_Tables --
1845    ------------------
1846
1847    procedure Reset_Tables is
1848    begin
1849       Objects.Init;
1850       Objects_Htable.Reset;
1851       Foreigns.Init;
1852       ALIs.Init;
1853       Opts.Init;
1854       Processed_Projects.Reset;
1855       Library_Projs.Init;
1856    end Reset_Tables;
1857
1858 end MLib.Prj;