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-2011, AdaCore                     --
  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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with ALI;      use ALI;
  27 with Gnatvsn;  use Gnatvsn;
  28 with Makeutl;  use Makeutl;
  29 with MLib.Fil; use MLib.Fil;
  30 with MLib.Tgt; use MLib.Tgt;
  31 with MLib.Utl; use MLib.Utl;
  32 with Opt;
  33 with Output;   use Output;
  34 with Prj.Com;  use Prj.Com;
  35 with Prj.Env;  use Prj.Env;
  36 with Prj.Util; use Prj.Util;
  37 with Sinput.P;
  38 with Snames;   use Snames;
  39 with Switch;   use Switch;
  40 with Table;
  41 with Targparm; use Targparm;
  42 with Tempdir;
  43 with Types;    use Types;
  44
  45 with Ada.Characters.Handling;
  46
  47 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  48 with GNAT.HTable;
  49 with Interfaces.C_Streams;      use Interfaces.C_Streams;
  50 with System;                    use System;
  51 with System.Case_Util;          use System.Case_Util;
  52
  53 package body MLib.Prj is
  54
  55    Prj_Add_Obj_Files : Types.Int;
  56    pragma Import (C, Prj_Add_Obj_Files, "__gnat_prj_add_obj_files");
  57    Add_Object_Files : constant Boolean := Prj_Add_Obj_Files /= 0;
  58    --  Indicates if object files in pragmas Linker_Options (found in the
  59    --  binder generated file) should be taken when linking a stand-alone
  60    --  library. False for Windows, True for other platforms.
  61
  62    ALI_Suffix : constant String := ".ali";
  63
  64    B_Start : String_Ptr := new String'("b~");
  65    --  Prefix of bind file, changed to b__ for VMS
  66
  67    S_Osinte_Ads : File_Name_Type := No_File;
  68    --  Name_Id for "s-osinte.ads"
  69
  70    S_Dec_Ads : File_Name_Type := No_File;
  71    --  Name_Id for "dec.ads"
  72
  73    G_Trasym_Ads : File_Name_Type := No_File;
  74    --  Name_Id for "g-trasym.ads"
  75
  76    Arguments : String_List_Access := No_Argument;
  77    --  Used to accumulate arguments for the invocation of gnatbind and of the
  78    --  compiler. Also used to collect the interface ALI when copying the ALI
  79    --  files to the library directory.
  80
  81    Argument_Number : Natural := 0;
  82    --  Index of the last argument in Arguments
  83
  84    Initial_Argument_Max : constant := 10;
  85    --  Where does the magic constant 10 come from???
  86
  87    No_Main_String        : aliased String         := "-n";
  88    No_Main               : constant String_Access := No_Main_String'Access;
  89
  90    Output_Switch_String  : aliased String         := "-o";
  91    Output_Switch         : constant String_Access :=
  92                              Output_Switch_String'Access;
  93
  94    Compile_Switch_String : aliased String         := "-c";
  95    Compile_Switch        : constant String_Access :=
  96                              Compile_Switch_String'Access;
  97
  98    No_Warning_String     : aliased String         := "-gnatws";
  99    No_Warning            : constant String_Access := No_Warning_String'Access;
 100
 101    Auto_Initialize : constant String := "-a";
 102
 103    --  List of objects to put inside the library
 104
 105    Object_Files : Argument_List_Access;
 106
 107    package Objects is new Table.Table
 108      (Table_Name           => "Mlib.Prj.Objects",
 109       Table_Component_Type => String_Access,
 110       Table_Index_Type     => Natural,
 111       Table_Low_Bound      => 1,
 112       Table_Initial        => 50,
 113       Table_Increment      => 100);
 114
 115    package Objects_Htable is new GNAT.HTable.Simple_HTable
 116      (Header_Num => Header_Num,
 117       Element    => Boolean,
 118       No_Element => False,
 119       Key        => Name_Id,
 120       Hash       => Hash,
 121       Equal      => "=");
 122
 123    --  List of ALI files
 124
 125    Ali_Files : Argument_List_Access;
 126
 127    package ALIs is new Table.Table
 128      (Table_Name           => "Mlib.Prj.Alis",
 129       Table_Component_Type => String_Access,
 130       Table_Index_Type     => Natural,
 131       Table_Low_Bound      => 1,
 132       Table_Initial        => 50,
 133       Table_Increment      => 100);
 134
 135    --  List of options set in the command line
 136
 137    Options : Argument_List_Access;
 138
 139    package Opts is new Table.Table
 140      (Table_Name           => "Mlib.Prj.Opts",
 141       Table_Component_Type => String_Access,
 142       Table_Index_Type     => Natural,
 143       Table_Low_Bound      => 1,
 144       Table_Initial        => 5,
 145       Table_Increment      => 100);
 146
 147    --  All the ALI file in the library
 148
 149    package Library_ALIs is new GNAT.HTable.Simple_HTable
 150      (Header_Num => Header_Num,
 151       Element    => Boolean,
 152       No_Element => False,
 153       Key        => File_Name_Type,
 154       Hash       => Hash,
 155       Equal      => "=");
 156
 157    --  The ALI files in the interface sets
 158
 159    package Interface_ALIs is new GNAT.HTable.Simple_HTable
 160      (Header_Num => Header_Num,
 161       Element    => Boolean,
 162       No_Element => False,
 163       Key        => File_Name_Type,
 164       Hash       => Hash,
 165       Equal      => "=");
 166
 167    --  The ALI files that have been processed to check if the corresponding
 168    --  library unit is in the interface set.
 169
 170    package Processed_ALIs is new GNAT.HTable.Simple_HTable
 171      (Header_Num => Header_Num,
 172       Element    => Boolean,
 173       No_Element => False,
 174       Key        => File_Name_Type,
 175       Hash       => Hash,
 176       Equal      => "=");
 177
 178    --  The projects imported directly or indirectly
 179
 180    package Processed_Projects is new GNAT.HTable.Simple_HTable
 181      (Header_Num => Header_Num,
 182       Element    => Boolean,
 183       No_Element => False,
 184       Key        => Name_Id,
 185       Hash       => Hash,
 186       Equal      => "=");
 187
 188    --  The library projects imported directly or indirectly
 189
 190    package Library_Projs is new Table.Table (
 191      Table_Component_Type => Project_Id,
 192      Table_Index_Type     => Integer,
 193      Table_Low_Bound      => 1,
 194      Table_Initial        => 10,
 195      Table_Increment      => 10,
 196      Table_Name           => "Make.Library_Projs");
 197
 198    type Build_Mode_State is (None, Static, Dynamic, Relocatable);
 199
 200    procedure Add_Argument (S : String);
 201    --  Add one argument to Arguments array, if array is full, double its size
 202
 203    function ALI_File_Name (Source : String) return String;
 204    --  Return the ALI file name corresponding to a source
 205
 206    procedure Check (Filename : String);
 207    --  Check if filename is a regular file. Fail if it is not
 208
 209    procedure Check_Context;
 210    --  Check each object files in table Object_Files
 211    --  Fail if any of them is not a regular file
 212
 213    procedure Copy_Interface_Sources
 214      (For_Project : Project_Id;
 215       In_Tree     : Project_Tree_Ref;
 216       Interfaces  : Argument_List;
 217       To_Dir      : Path_Name_Type);
 218    --  Copy the interface sources of a SAL to directory To_Dir
 219
 220    procedure Display (Executable : String);
 221    --  Display invocation of gnatbind and of the compiler with the arguments
 222    --  in Arguments, except when Quiet_Output is True.
 223
 224    function Index (S, Pattern : String) return Natural;
 225    --  Return the last occurrence of Pattern in S, or 0 if none
 226
 227    procedure Process_Binder_File (Name : String);
 228    --  For Stand-Alone libraries, get the Linker Options in the binder
 229    --  generated file.
 230
 231    procedure Reset_Tables;
 232    --  Make sure that all the above tables are empty
 233    --  (Objects, Ali_Files, Options).
 234
 235    function SALs_Use_Constructors return Boolean;
 236    --  Indicate if Stand-Alone Libraries are automatically initialized using
 237    --  the constructor mechanism.
 238
 239    ------------------
 240    -- Add_Argument --
 241    ------------------
 242
 243    procedure Add_Argument (S : String) is
 244    begin
 245       if Argument_Number = Arguments'Last then
 246          declare
 247             New_Args : constant String_List_Access :=
 248               new String_List (1 .. 2 * Arguments'Last);
 249
 250          begin
 251             --  Copy the String_Accesses and set them to null in Arguments
 252             --  so that they will not be deallocated by the call to
 253             --  Free (Arguments).
 254
 255             New_Args (Arguments'Range) := Arguments.all;
 256             Arguments.all := (others => null);
 257             Free (Arguments);
 258             Arguments := New_Args;
 259          end;
 260       end if;
 261
 262       Argument_Number := Argument_Number + 1;
 263       Arguments (Argument_Number) := new String'(S);
 264    end Add_Argument;
 265
 266    -------------------
 267    -- ALI_File_Name --
 268    -------------------
 269
 270    function ALI_File_Name (Source : String) return String is
 271    begin
 272       --  If the source name has an extension, then replace it with
 273       --  the ALI suffix.
 274
 275       for Index in reverse Source'First + 1 .. Source'Last loop
 276          if Source (Index) = '.' then
 277             return Source (Source'First .. Index - 1) & ALI_Suffix;
 278          end if;
 279       end loop;
 280
 281       --  If there is no dot, or if it is the first character, just add the
 282       --  ALI suffix.
 283
 284       return Source & ALI_Suffix;
 285    end ALI_File_Name;
 286
 287    -------------------
 288    -- Build_Library --
 289    -------------------
 290
 291    procedure Build_Library
 292      (For_Project   : Project_Id;
 293       In_Tree       : Project_Tree_Ref;
 294       Gnatbind      : String;
 295       Gnatbind_Path : String_Access;
 296       Gcc           : String;
 297       Gcc_Path      : String_Access;
 298       Bind          : Boolean := True;
 299       Link          : Boolean := True)
 300    is
 301       Maximum_Size : Integer;
 302       pragma Import (C, Maximum_Size, "__gnat_link_max");
 303       --  Maximum number of bytes to put in an invocation of gnatbind
 304
 305       Size : Integer;
 306       --  The number of bytes for the invocation of gnatbind
 307
 308       Warning_For_Library : Boolean := False;
 309       --  Set True for first warning for a unit missing from the interface set
 310
 311       Current_Proj : Project_Id;
 312
 313       Libgnarl_Needed   : Yes_No_Unknown := For_Project.Libgnarl_Needed;
 314       --  Set True if library needs to be linked with libgnarl
 315
 316       Libdecgnat_Needed : Boolean := False;
 317       --  On OpenVMS, set True if library needs to be linked with libdecgnat
 318
 319       Gtrasymobj_Needed : Boolean := False;
 320       --  On OpenVMS, set rue if library needs to be linked with g-trasym.obj
 321
 322       Object_Directory_Path : constant String :=
 323                                 Get_Name_String
 324                                   (For_Project.Object_Directory.Display_Name);
 325
 326       Standalone   : constant Boolean := For_Project.Standalone_Library;
 327
 328       Project_Name : constant String := Get_Name_String (For_Project.Name);
 329
 330       Current_Dir  : constant String := Get_Current_Dir;
 331
 332       Lib_Filename : String_Access;
 333       Lib_Dirpath  : String_Access;
 334       Lib_Version  : String_Access := new String'("");
 335
 336       The_Build_Mode : Build_Mode_State := None;
 337
 338       Success : Boolean := False;
 339
 340       Library_Options : Variable_Value := Nil_Variable_Value;
 341
 342       Driver_Name : Name_Id := No_Name;
 343
 344       In_Main_Object_Directory : Boolean := True;
 345
 346       Foreign_Sources : Boolean;
 347
 348       Rpath : String_Access := null;
 349       --  Allocated only if Path Option is supported
 350
 351       Rpath_Last : Natural := 0;
 352       --  Index of last valid character of Rpath
 353
 354       Initial_Rpath_Length : constant := 200;
 355       --  Initial size of Rpath, when first allocated
 356
 357       Path_Option : String_Access := Linker_Library_Path_Option;
 358       --  If null, Path Option is not supported. Not a constant so that it can
 359       --  be deallocated.
 360
 361       First_ALI : File_Name_Type := No_File;
 362       --  Store the ALI file name of a source of the library (the first found)
 363
 364       procedure Add_ALI_For (Source : File_Name_Type);
 365       --  Add name of the ALI file corresponding to Source to the Arguments
 366
 367       procedure Add_Rpath (Path : String);
 368       --  Add a path name to Rpath
 369
 370       function Check_Project (P : Project_Id) return Boolean;
 371       --  Returns True if P is For_Project or a project extended by For_Project
 372
 373       procedure Check_Libs (ALI_File : String; Main_Project : Boolean);
 374       --  Set Libgnarl_Needed if the ALI_File indicates that there is a need
 375       --  to link with -lgnarl (this is the case when there is a dependency
 376       --  on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
 377       --  indicates that there is a need to link with -ldecgnat (this is the
 378       --  case when there is a dependency on dec.ads). Set Gtrasymobj_Needed
 379       --  if there is a dependency on g-trasym.ads.
 380
 381       procedure Process (The_ALI : File_Name_Type);
 382       --  Check if the closure of a library unit which is or should be in the
 383       --  interface set is also in the interface set. Issue a warning for each
 384       --  missing library unit.
 385
 386       procedure Process_Imported_Libraries;
 387       --  Add the -L and -l switches for the imported Library Project Files,
 388       --  and, if Path Option is supported, the library directory path names
 389       --  to Rpath.
 390
 391       -----------------
 392       -- Add_ALI_For --
 393       -----------------
 394
 395       procedure Add_ALI_For (Source : File_Name_Type) is
 396          ALI    : constant String := ALI_File_Name (Get_Name_String (Source));
 397          ALI_Id : File_Name_Type;
 398
 399       begin
 400          if Bind then
 401             Add_Argument (ALI);
 402          end if;
 403
 404          Name_Len := 0;
 405          Add_Str_To_Name_Buffer (S => ALI);
 406          ALI_Id := Name_Find;
 407
 408          --  Add the ALI file name to the library ALIs
 409
 410          if Bind then
 411             Library_ALIs.Set (ALI_Id, True);
 412          end if;
 413
 414          --  Set First_ALI, if not already done
 415
 416          if First_ALI = No_File then
 417             First_ALI := ALI_Id;
 418          end if;
 419       end Add_ALI_For;
 420
 421       ---------------
 422       -- Add_Rpath --
 423       ---------------
 424
 425       procedure Add_Rpath (Path : String) is
 426
 427          procedure Double;
 428          --  Double Rpath size
 429
 430          ------------
 431          -- Double --
 432          ------------
 433
 434          procedure Double is
 435             New_Rpath : constant String_Access :=
 436                           new String (1 .. 2 * Rpath'Length);
 437          begin
 438             New_Rpath (1 .. Rpath_Last) := Rpath (1 .. Rpath_Last);
 439             Free (Rpath);
 440             Rpath := New_Rpath;
 441          end Double;
 442
 443       --  Start of processing for Add_Rpath
 444
 445       begin
 446          --  If first path, allocate initial Rpath
 447
 448          if Rpath = null then
 449             Rpath := new String (1 .. Initial_Rpath_Length);
 450             Rpath_Last := 0;
 451
 452          else
 453             --  Otherwise, add a path separator between two path names
 454
 455             if Rpath_Last = Rpath'Last then
 456                Double;
 457             end if;
 458
 459             Rpath_Last := Rpath_Last + 1;
 460             Rpath (Rpath_Last) := Path_Separator;
 461          end if;
 462
 463          --  Increase Rpath size until it is large enough
 464
 465          while Rpath_Last + Path'Length > Rpath'Last loop
 466             Double;
 467          end loop;
 468
 469          --  Add the path name
 470
 471          Rpath (Rpath_Last + 1 .. Rpath_Last + Path'Length) := Path;
 472          Rpath_Last := Rpath_Last + Path'Length;
 473       end Add_Rpath;
 474
 475       -------------------
 476       -- Check_Project --
 477       -------------------
 478
 479       function Check_Project (P : Project_Id) return Boolean is
 480       begin
 481          if P = For_Project then
 482             return True;
 483
 484          elsif P /= No_Project then
 485             declare
 486                Proj : Project_Id;
 487
 488             begin
 489                Proj := For_Project;
 490                while Proj.Extends /= No_Project loop
 491                   if P = Proj.Extends then
 492                      return True;
 493                   end if;
 494
 495                   Proj := Proj.Extends;
 496                end loop;
 497             end;
 498          end if;
 499
 500          return False;
 501       end Check_Project;
 502
 503       ----------------
 504       -- Check_Libs --
 505       ----------------
 506
 507       procedure Check_Libs (ALI_File : String; Main_Project : Boolean) is
 508          Lib_File : File_Name_Type;
 509          Text     : Text_Buffer_Ptr;
 510          Id       : ALI.ALI_Id;
 511
 512       begin
 513          if Libgnarl_Needed /= Yes
 514            or else
 515             (Main_Project
 516               and then OpenVMS_On_Target
 517               and then ((not Libdecgnat_Needed) or (not Gtrasymobj_Needed)))
 518          then
 519             --  Scan the ALI file
 520
 521             Name_Len := ALI_File'Length;
 522             Name_Buffer (1 .. Name_Len) := ALI_File;
 523             Lib_File := Name_Find;
 524             Text := Read_Library_Info (Lib_File, True);
 525
 526             Id := ALI.Scan_ALI
 527                     (F          => Lib_File,
 528                      T          => Text,
 529                      Ignore_ED  => False,
 530                      Err        => True,
 531                      Read_Lines => "D");
 532             Free (Text);
 533
 534             --  Look for s-osinte.ads in the dependencies
 535
 536             for Index in ALI.ALIs.Table (Id).First_Sdep ..
 537                          ALI.ALIs.Table (Id).Last_Sdep
 538             loop
 539                if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
 540                   Libgnarl_Needed := Yes;
 541
 542                   if Main_Project then
 543                      For_Project.Libgnarl_Needed := Yes;
 544                   else
 545                      exit;
 546                   end if;
 547
 548                elsif OpenVMS_On_Target then
 549                   if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then
 550                      Libdecgnat_Needed := True;
 551
 552                   elsif ALI.Sdep.Table (Index).Sfile = G_Trasym_Ads then
 553                      Gtrasymobj_Needed := True;
 554                   end if;
 555                end if;
 556             end loop;
 557          end if;
 558       end Check_Libs;
 559
 560       -------------
 561       -- Process --
 562       -------------
 563
 564       procedure Process (The_ALI : File_Name_Type) is
 565          Text       : Text_Buffer_Ptr;
 566          Idread     : ALI_Id;
 567          First_Unit : ALI.Unit_Id;
 568          Last_Unit  : ALI.Unit_Id;
 569          Unit_Data  : Unit_Record;
 570          Afile      : File_Name_Type;
 571
 572       begin
 573          --  Nothing to do if the ALI file has already been processed.
 574          --  This happens if an interface imports another interface.
 575
 576          if not Processed_ALIs.Get (The_ALI) then
 577             Processed_ALIs.Set (The_ALI, True);
 578             Text := Read_Library_Info (The_ALI);
 579
 580             if Text /= null then
 581                Idread :=
 582                  Scan_ALI
 583                    (F         => The_ALI,
 584                     T         => Text,
 585                     Ignore_ED => False,
 586                     Err       => True);
 587                Free (Text);
 588
 589                if Idread /= No_ALI_Id then
 590                   First_Unit := ALI.ALIs.Table (Idread).First_Unit;
 591                   Last_Unit  := ALI.ALIs.Table (Idread).Last_Unit;
 592
 593                   --  Process both unit (spec and body) if the body is needed
 594                   --  by the spec (inline or generic). Otherwise, just process
 595                   --  the spec.
 596
 597                   if First_Unit /= Last_Unit and then
 598                     not ALI.Units.Table (Last_Unit).Body_Needed_For_SAL
 599                   then
 600                      First_Unit := Last_Unit;
 601                   end if;
 602
 603                   for Unit in First_Unit .. Last_Unit loop
 604                      Unit_Data := ALI.Units.Table (Unit);
 605
 606                      --  Check if each withed unit which is in the library is
 607                      --  also in the interface set, if it has not yet been
 608                      --  processed.
 609
 610                      for W in Unit_Data.First_With .. Unit_Data.Last_With loop
 611                         Afile := Withs.Table (W).Afile;
 612
 613                         if Afile /= No_File and then Library_ALIs.Get (Afile)
 614                           and then not Processed_ALIs.Get (Afile)
 615                         then
 616                            if not Interface_ALIs.Get (Afile) then
 617                               if not Warning_For_Library then
 618                                  Write_Str ("Warning: In library project """);
 619                                  Get_Name_String (Current_Proj.Name);
 620                                  To_Mixed (Name_Buffer (1 .. Name_Len));
 621                                  Write_Str (Name_Buffer (1 .. Name_Len));
 622                                  Write_Line ("""");
 623                                  Warning_For_Library := True;
 624                               end if;
 625
 626                               Write_Str ("         Unit """);
 627                               Get_Name_String (Withs.Table (W).Uname);
 628                               To_Mixed (Name_Buffer (1 .. Name_Len - 2));
 629                               Write_Str (Name_Buffer (1 .. Name_Len - 2));
 630                               Write_Line (""" is not in the interface set");
 631                               Write_Str ("         but it is needed by ");
 632
 633                               case Unit_Data.Utype is
 634                                  when Is_Spec =>
 635                                     Write_Str ("the spec of ");
 636
 637                                  when Is_Body =>
 638                                     Write_Str ("the body of ");
 639
 640                                  when others =>
 641                                     null;
 642                               end case;
 643
 644                               Write_Str ("""");
 645                               Get_Name_String (Unit_Data.Uname);
 646                               To_Mixed (Name_Buffer (1 .. Name_Len - 2));
 647                               Write_Str (Name_Buffer (1 .. Name_Len - 2));
 648                               Write_Line ("""");
 649                            end if;
 650
 651                            --  Now, process this unit
 652
 653                            Process (Afile);
 654                         end if;
 655                      end loop;
 656                   end loop;
 657                end if;
 658             end if;
 659          end if;
 660       end Process;
 661
 662       --------------------------------
 663       -- Process_Imported_Libraries --
 664       --------------------------------
 665
 666       procedure Process_Imported_Libraries is
 667          Current : Project_Id;
 668
 669          procedure Process_Project (Project : Project_Id);
 670          --  Process Project and its imported projects recursively.
 671          --  Add any library projects to table Library_Projs.
 672
 673          ---------------------
 674          -- Process_Project --
 675          ---------------------
 676
 677          procedure Process_Project (Project : Project_Id) is
 678             Imported : Project_List;
 679
 680          begin
 681             --  Nothing to do if process has already been processed
 682
 683             if not Processed_Projects.Get (Project.Name) then
 684                Processed_Projects.Set (Project.Name, True);
 685
 686                --  Call Process_Project recursively for any imported project.
 687                --  We first process the imported projects to guarantee that
 688                --  we have a proper reverse order for the libraries.
 689
 690                Imported := Project.Imported_Projects;
 691                while Imported /= null loop
 692                   if Imported.Project /= No_Project then
 693                      Process_Project (Imported.Project);
 694                   end if;
 695
 696                   Imported := Imported.Next;
 697                end loop;
 698
 699                --  If it is a library project, add it to Library_Projs
 700
 701                if Project /= For_Project and then Project.Library then
 702                   Library_Projs.Increment_Last;
 703                   Library_Projs.Table (Library_Projs.Last) := Project;
 704
 705                   --  Check if because of this library we need to use libgnarl
 706
 707                   if Libgnarl_Needed = Unknown then
 708                      if Project.Libgnarl_Needed = Unknown
 709                        and then Project.Object_Directory /= No_Path_Information
 710                      then
 711                         --  Check if libgnarl is needed for this library
 712
 713                         declare
 714                            Object_Dir_Path : constant String :=
 715                                                Get_Name_String
 716                                                  (Project.Object_Directory.
 717                                                     Display_Name);
 718                            Object_Dir      : Dir_Type;
 719                            Filename        : String (1 .. 255);
 720                            Last            : Natural;
 721
 722                         begin
 723                            Open (Object_Dir, Object_Dir_Path);
 724
 725                            --  For all entries in the object directory
 726
 727                            loop
 728                               Read (Object_Dir, Filename, Last);
 729                               exit when Last = 0;
 730
 731                               --  Check if it is an object file
 732
 733                               if Is_Obj (Filename (1 .. Last)) then
 734                                  declare
 735                                     Object_Path : constant String :=
 736                                                     Normalize_Pathname
 737                                                       (Object_Dir_Path &
 738                                                        Directory_Separator &
 739                                                        Filename (1 .. Last));
 740                                     ALI_File    : constant String :=
 741                                                     Ext_To
 742                                                       (Object_Path, "ali");
 743
 744                                  begin
 745                                     if Is_Regular_File (ALI_File) then
 746
 747                                        --  Find out if for this ALI file,
 748                                        --  libgnarl is necessary.
 749
 750                                        Check_Libs
 751                                          (ALI_File, Main_Project => False);
 752
 753                                        if Libgnarl_Needed = Yes then
 754                                           Project.Libgnarl_Needed := Yes;
 755                                           For_Project.Libgnarl_Needed := Yes;
 756                                           exit;
 757                                        end if;
 758                                     end if;
 759                                  end;
 760                               end if;
 761                            end loop;
 762
 763                            Close (Object_Dir);
 764                         end;
 765                      end if;
 766
 767                      if Project.Libgnarl_Needed = Yes then
 768                         Libgnarl_Needed := Yes;
 769                         For_Project.Libgnarl_Needed := Yes;
 770                      end if;
 771                   end if;
 772                end if;
 773             end if;
 774          end Process_Project;
 775
 776       --  Start of processing for Process_Imported_Libraries
 777
 778       begin
 779          --  Build list of library projects imported directly or indirectly,
 780          --  in the reverse order.
 781
 782          Process_Project (For_Project);
 783
 784          --  Add the -L and -l switches and, if the Rpath option is supported,
 785          --  add the directory to the Rpath. As the library projects are in the
 786          --  wrong order, process from the last to the first.
 787
 788          for Index in reverse 1 .. Library_Projs.Last loop
 789             Current := Library_Projs.Table (Index);
 790
 791             Get_Name_String (Current.Library_Dir.Display_Name);
 792             Opts.Increment_Last;
 793             Opts.Table (Opts.Last) :=
 794               new String'("-L" & Name_Buffer (1 .. Name_Len));
 795
 796             if Path_Option /= null then
 797                Add_Rpath (Name_Buffer (1 .. Name_Len));
 798             end if;
 799
 800             Opts.Increment_Last;
 801             Opts.Table (Opts.Last) :=
 802               new String'("-l" & Get_Name_String (Current.Library_Name));
 803          end loop;
 804       end Process_Imported_Libraries;
 805
 806       Path_FD : File_Descriptor := Invalid_FD;
 807       --  Used for setting the source and object paths
 808
 809    --  Start of processing for Build_Library
 810
 811    begin
 812       Reset_Tables;
 813
 814       --  Fail if project is not a library project
 815
 816       if not For_Project.Library then
 817          Com.Fail ("project """ & Project_Name & """ has no library");
 818       end if;
 819
 820       --  Do not attempt to build the library if it is externally built
 821
 822       if For_Project.Externally_Built then
 823          return;
 824       end if;
 825
 826       --  If this is the first time Build_Library is called, get the Name_Id
 827       --  of "s-osinte.ads".
 828
 829       if S_Osinte_Ads = No_File then
 830          Name_Len := 0;
 831          Add_Str_To_Name_Buffer ("s-osinte.ads");
 832          S_Osinte_Ads := Name_Find;
 833       end if;
 834
 835       if S_Dec_Ads = No_File then
 836          Name_Len := 0;
 837          Add_Str_To_Name_Buffer ("dec.ads");
 838          S_Dec_Ads := Name_Find;
 839       end if;
 840
 841       if G_Trasym_Ads = No_File then
 842          Name_Len := 0;
 843          Add_Str_To_Name_Buffer ("g-trasym.ads");
 844          G_Trasym_Ads := Name_Find;
 845       end if;
 846
 847       --  We work in the object directory
 848
 849       Change_Dir (Object_Directory_Path);
 850
 851       if Standalone then
 852
 853          --  Call gnatbind only if Bind is True
 854
 855          if Bind then
 856             if Gnatbind_Path = null then
 857                Com.Fail ("unable to locate " & Gnatbind);
 858             end if;
 859
 860             if Gcc_Path = null then
 861                Com.Fail ("unable to locate " & Gcc);
 862             end if;
 863
 864             --  Allocate Arguments, if it is the first time we see a standalone
 865             --  library.
 866
 867             if Arguments = No_Argument then
 868                Arguments := new String_List (1 .. Initial_Argument_Max);
 869             end if;
 870
 871             --  Add "-n -o b~<lib>.adb (b__<lib>.adb on VMS) -L<lib>_"
 872
 873             Argument_Number := 2;
 874             Arguments (1) := No_Main;
 875             Arguments (2) := Output_Switch;
 876
 877             if OpenVMS_On_Target then
 878                B_Start := new String'("b__");
 879             end if;
 880
 881             Add_Argument
 882               (B_Start.all
 883                & Get_Name_String (For_Project.Library_Name) & ".adb");
 884
 885             --  Make sure that the init procedure is never "adainit"
 886
 887             Get_Name_String (For_Project.Library_Name);
 888
 889             if Name_Buffer (1 .. Name_Len) = "ada" then
 890                Add_Argument ("-Lada_");
 891             else
 892                Add_Argument
 893                  ("-L" & Get_Name_String (For_Project.Library_Name));
 894             end if;
 895
 896             if For_Project.Lib_Auto_Init and then SALs_Use_Constructors then
 897                Add_Argument (Auto_Initialize);
 898             end if;
 899
 900             --  Check if Binder'Default_Switches ("Ada") is defined. If it is,
 901             --  add these switches to call gnatbind.
 902
 903             declare
 904                Binder_Package : constant Package_Id :=
 905                                   Value_Of
 906                                     (Name        => Name_Binder,
 907                                      In_Packages => For_Project.Decl.Packages,
 908                                      Shared      => In_Tree.Shared);
 909
 910             begin
 911                if Binder_Package /= No_Package then
 912                   declare
 913                      Defaults : constant Array_Element_Id :=
 914                                   Value_Of
 915                                     (Name      => Name_Default_Switches,
 916                                      In_Arrays =>
 917                                        In_Tree.Shared.Packages.Table
 918                                          (Binder_Package).Decl.Arrays,
 919                                      Shared    => In_Tree.Shared);
 920
 921                      Switches : Variable_Value := Nil_Variable_Value;
 922                      Switch   : String_List_Id := Nil_String;
 923
 924                   begin
 925                      if Defaults /= No_Array_Element then
 926                         Switches :=
 927                           Value_Of
 928                             (Index     => Name_Ada,
 929                              Src_Index => 0,
 930                              In_Array  => Defaults,
 931                              Shared    => In_Tree.Shared);
 932
 933                         if not Switches.Default then
 934                            Switch := Switches.Values;
 935
 936                            while Switch /= Nil_String loop
 937                               Add_Argument
 938                                 (Get_Name_String
 939                                    (In_Tree.Shared.String_Elements.Table
 940                                       (Switch).Value));
 941                               Switch := In_Tree.Shared.String_Elements.
 942                                           Table (Switch).Next;
 943                            end loop;
 944                         end if;
 945                      end if;
 946                   end;
 947                end if;
 948             end;
 949          end if;
 950
 951          --  Get all the ALI files of the project file. We do that even if
 952          --  Bind is False, so that First_ALI is set.
 953
 954          declare
 955             Unit : Unit_Index;
 956
 957          begin
 958             Library_ALIs.Reset;
 959             Interface_ALIs.Reset;
 960             Processed_ALIs.Reset;
 961
 962             Unit := Units_Htable.Get_First (In_Tree.Units_HT);
 963             while Unit /= No_Unit_Index loop
 964                if Unit.File_Names (Impl) /= null
 965                  and then not Unit.File_Names (Impl).Locally_Removed
 966                then
 967                   if Check_Project (Unit.File_Names (Impl).Project) then
 968                      if Unit.File_Names (Spec) = null then
 969
 970                         --  Add the ALI file only if it is not a subunit
 971
 972                         declare
 973                            Src_Ind : constant Source_File_Index :=
 974                                        Sinput.P.Load_Project_File
 975                                          (Get_Name_String
 976                                            (Unit.File_Names (Impl).Path.Name));
 977                         begin
 978                            if not
 979                              Sinput.P.Source_File_Is_Subunit (Src_Ind)
 980                            then
 981                               Add_ALI_For (Unit.File_Names (Impl).File);
 982                               exit when not Bind;
 983                            end if;
 984                         end;
 985
 986                      else
 987                         Add_ALI_For (Unit.File_Names (Impl).File);
 988                         exit when not Bind;
 989                      end if;
 990                   end if;
 991
 992                elsif Unit.File_Names (Spec) /= null
 993                  and then not Unit.File_Names (Spec).Locally_Removed
 994                  and then Check_Project (Unit.File_Names (Spec).Project)
 995                then
 996                   Add_ALI_For (Unit.File_Names (Spec).File);
 997                   exit when not Bind;
 998                end if;
 999
1000                Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
1001             end loop;
1002          end;
1003
1004          --  Continue setup and call gnatbind if Bind is True
1005
1006          if Bind then
1007
1008             --  Get an eventual --RTS from the ALI file
1009
1010             if First_ALI /= No_File then
1011                declare
1012                   T : Text_Buffer_Ptr;
1013                   A : ALI_Id;
1014
1015                begin
1016                   --  Load the ALI file
1017
1018                   T := Read_Library_Info (First_ALI, True);
1019
1020                   --  Read it
1021
1022                   A := Scan_ALI
1023                          (First_ALI, T, Ignore_ED => False, Err => False);
1024
1025                   if A /= No_ALI_Id then
1026                      for Index in
1027                        ALI.Units.Table
1028                          (ALI.ALIs.Table (A).First_Unit).First_Arg ..
1029                        ALI.Units.Table
1030                          (ALI.ALIs.Table (A).First_Unit).Last_Arg
1031                      loop
1032                         --  If --RTS found, add switch to call gnatbind
1033
1034                         declare
1035                            Arg : String_Ptr renames Args.Table (Index);
1036                         begin
1037                            if Arg'Length >= 6 and then
1038                               Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
1039                            then
1040                               Add_Argument (Arg.all);
1041                               exit;
1042                            end if;
1043                         end;
1044                      end loop;
1045                   end if;
1046                end;
1047             end if;
1048
1049             --  Set the paths
1050
1051             --  First the source path
1052
1053             if For_Project.Include_Path_File = No_Path then
1054                Get_Directories
1055                  (Project_Tree => In_Tree,
1056                   For_Project  => For_Project,
1057                   Activity     => Compilation,
1058                   Languages    => Ada_Only);
1059
1060                Create_New_Path_File
1061                  (In_Tree.Shared, Path_FD, For_Project.Include_Path_File);
1062
1063                Write_Path_File (Path_FD);
1064                Path_FD := Invalid_FD;
1065             end if;
1066
1067             if Current_Source_Path_File_Of (In_Tree.Shared) /=
1068                                                 For_Project.Include_Path_File
1069             then
1070                Set_Current_Source_Path_File_Of
1071                  (In_Tree.Shared, For_Project.Include_Path_File);
1072                Set_Path_File_Var
1073                  (Project_Include_Path_File,
1074                   Get_Name_String (For_Project.Include_Path_File));
1075             end if;
1076
1077             --  Then, the object path
1078
1079             Get_Directories
1080               (Project_Tree => In_Tree,
1081                For_Project  => For_Project,
1082                Activity     => SAL_Binding,
1083                Languages    => Ada_Only);
1084
1085             declare
1086                Path_File_Name : Path_Name_Type;
1087
1088             begin
1089                Create_New_Path_File (In_Tree.Shared, Path_FD, Path_File_Name);
1090
1091                Write_Path_File (Path_FD);
1092                Path_FD := Invalid_FD;
1093
1094                Set_Path_File_Var
1095                  (Project_Objects_Path_File, Get_Name_String (Path_File_Name));
1096                Set_Current_Source_Path_File_Of
1097                  (In_Tree.Shared, Path_File_Name);
1098             end;
1099
1100             --  Display the gnatbind command, if not in quiet output
1101
1102             Display (Gnatbind);
1103
1104             Size := 0;
1105             for J in 1 .. Argument_Number loop
1106                Size := Size + Arguments (J)'Length + 1;
1107             end loop;
1108
1109             --  Invoke gnatbind with the arguments if the size is not too large
1110
1111             if Size <= Maximum_Size then
1112                Spawn
1113                  (Gnatbind_Path.all,
1114                   Arguments (1 .. Argument_Number),
1115                   Success);
1116
1117             --  Otherwise create a temporary response file
1118
1119             else
1120                declare
1121                   FD            : File_Descriptor;
1122                   Path          : Path_Name_Type;
1123                   Args          : Argument_List (1 .. 1);
1124                   EOL           : constant String (1 .. 1) := (1 => ASCII.LF);
1125                   Status        : Integer;
1126                   Succ          : Boolean;
1127                   Quotes_Needed : Boolean;
1128                   Last_Char     : Natural;
1129                   Ch            : Character;
1130
1131                begin
1132                   Tempdir.Create_Temp_File (FD, Path);
1133                   Args (1) := new String'("@" & Get_Name_String (Path));
1134
1135                   for J in 1 .. Argument_Number loop
1136
1137                      --  Check if the argument should be quoted
1138
1139                      Quotes_Needed := False;
1140                      Last_Char     := Arguments (J)'Length;
1141
1142                      for K in Arguments (J)'Range loop
1143                         Ch := Arguments (J) (K);
1144
1145                         if Ch = ' ' or else Ch = ASCII.HT or else Ch = '"' then
1146                            Quotes_Needed := True;
1147                            exit;
1148                         end if;
1149                      end loop;
1150
1151                      if Quotes_Needed then
1152
1153                         --  Quote the argument, doubling '"'
1154
1155                         declare
1156                            Arg : String (1 .. Arguments (J)'Length * 2 + 2);
1157
1158                         begin
1159                            Arg (1) := '"';
1160                            Last_Char := 1;
1161
1162                            for K in Arguments (J)'Range loop
1163                               Ch := Arguments (J) (K);
1164                               Last_Char := Last_Char + 1;
1165                               Arg (Last_Char) := Ch;
1166
1167                               if Ch = '"' then
1168                                  Last_Char := Last_Char + 1;
1169                                  Arg (Last_Char) := '"';
1170                               end if;
1171                            end loop;
1172
1173                            Last_Char := Last_Char + 1;
1174                            Arg (Last_Char) := '"';
1175
1176                            Status := Write (FD, Arg'Address, Last_Char);
1177                         end;
1178
1179                      else
1180                         Status := Write
1181                           (FD,
1182                            Arguments (J) (Arguments (J)'First)'Address,
1183                            Last_Char);
1184                      end if;
1185
1186                      if Status /= Last_Char then
1187                         Fail ("disk full");
1188                      end if;
1189
1190                      Status := Write (FD, EOL (1)'Address, 1);
1191
1192                      if Status /= 1 then
1193                         Fail ("disk full");
1194                      end if;
1195                   end loop;
1196
1197                   Close (FD);
1198
1199                   --  And invoke gnatbind with this response file
1200
1201                   Spawn (Gnatbind_Path.all, Args, Success);
1202
1203                   Delete_File (Get_Name_String (Path), Succ);
1204
1205                   if not Succ then
1206                      null;
1207                   end if;
1208                end;
1209             end if;
1210
1211             if not Success then
1212                Com.Fail ("could not bind standalone library "
1213                          & Get_Name_String (For_Project.Library_Name));
1214             end if;
1215          end if;
1216
1217          --  Compile the binder generated file only if Link is true
1218
1219          if Link then
1220
1221             --  Set the paths
1222
1223             Set_Ada_Paths
1224               (Project             => For_Project,
1225                In_Tree             => In_Tree,
1226                Including_Libraries => True);
1227
1228             --  Invoke <gcc> -c b__<lib>.adb
1229
1230             --  Allocate Arguments, if first time we see a standalone library
1231
1232             if Arguments = No_Argument then
1233                Arguments := new String_List (1 .. Initial_Argument_Max);
1234             end if;
1235
1236             Argument_Number := 2;
1237             Arguments (1) := Compile_Switch;
1238             Arguments (2) := No_Warning;
1239
1240             if OpenVMS_On_Target then
1241                B_Start := new String'("b__");
1242             end if;
1243
1244             Add_Argument
1245               (B_Start.all
1246                & Get_Name_String (For_Project.Library_Name) & ".adb");
1247
1248             --  If necessary, add the PIC option
1249
1250             if PIC_Option /= "" then
1251                Add_Argument (PIC_Option);
1252             end if;
1253
1254             --  Get the back-end switches and --RTS from the ALI file
1255
1256             if First_ALI /= No_File then
1257                declare
1258                   T : Text_Buffer_Ptr;
1259                   A : ALI_Id;
1260
1261                begin
1262                   --  Load the ALI file
1263
1264                   T := Read_Library_Info (First_ALI, True);
1265
1266                   --  Read it
1267
1268                   A :=
1269                     Scan_ALI (First_ALI, T, Ignore_ED => False, Err => False);
1270
1271                   if A /= No_ALI_Id then
1272                      for Index in
1273                        ALI.Units.Table
1274                          (ALI.ALIs.Table (A).First_Unit).First_Arg ..
1275                        ALI.Units.Table
1276                          (ALI.ALIs.Table (A).First_Unit).Last_Arg
1277                      loop
1278                         --  Do not compile with the front end switches except
1279                         --  for --RTS.
1280
1281                         declare
1282                            Arg : String_Ptr renames Args.Table (Index);
1283                         begin
1284                            if not Is_Front_End_Switch (Arg.all)
1285                              or else
1286                                Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
1287                            then
1288                               Add_Argument (Arg.all);
1289                            end if;
1290                         end;
1291                      end loop;
1292                   end if;
1293                end;
1294             end if;
1295
1296             --  Now all the arguments are set, compile binder generated file
1297
1298             Display (Gcc);
1299             Spawn
1300               (Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
1301
1302             if not Success then
1303                Com.Fail
1304                 ("could not compile binder generated file for library "
1305                   & Get_Name_String (For_Project.Library_Name));
1306             end if;
1307
1308             --  Process binder generated file for pragmas Linker_Options
1309
1310             Process_Binder_File (Arguments (3).all & ASCII.NUL);
1311          end if;
1312       end if;
1313
1314       --  Build the library only if Link is True
1315
1316       if Link then
1317
1318          --  If attributes Library_GCC or Linker'Driver were specified, get the
1319          --  driver name.
1320
1321          if For_Project.Config.Shared_Lib_Driver /= No_File then
1322             Driver_Name := Name_Id (For_Project.Config.Shared_Lib_Driver);
1323          end if;
1324
1325          --  If attribute Library_Options was specified, add these options
1326
1327          Library_Options := Value_Of
1328            (Name_Library_Options, For_Project.Decl.Attributes,
1329             In_Tree.Shared);
1330
1331          if not Library_Options.Default then
1332             declare
1333                Current : String_List_Id;
1334                Element : String_Element;
1335
1336             begin
1337                Current := Library_Options.Values;
1338                while Current /= Nil_String loop
1339                   Element := In_Tree.Shared.String_Elements.Table (Current);
1340                   Get_Name_String (Element.Value);
1341
1342                   if Name_Len /= 0 then
1343                      Opts.Increment_Last;
1344                      Opts.Table (Opts.Last) :=
1345                        new String'(Name_Buffer (1 .. Name_Len));
1346                   end if;
1347
1348                   Current := Element.Next;
1349                end loop;
1350             end;
1351          end if;
1352
1353          Lib_Dirpath  :=
1354            new String'(Get_Name_String (For_Project.Library_Dir.Display_Name));
1355          Lib_Filename :=
1356            new String'(Get_Name_String (For_Project.Library_Name));
1357
1358          case For_Project.Library_Kind is
1359             when Static =>
1360                The_Build_Mode := Static;
1361
1362             when Dynamic =>
1363                The_Build_Mode := Dynamic;
1364
1365             when Relocatable =>
1366                The_Build_Mode := Relocatable;
1367
1368                if PIC_Option /= "" then
1369                   Opts.Increment_Last;
1370                   Opts.Table (Opts.Last) := new String'(PIC_Option);
1371                end if;
1372          end case;
1373
1374          --  Get the library version, if any
1375
1376          if For_Project.Lib_Internal_Name /= No_Name then
1377             Lib_Version :=
1378               new String'(Get_Name_String (For_Project.Lib_Internal_Name));
1379          end if;
1380
1381          --  Add the objects found in the object directory and the object
1382          --  directories of the extended files, if any, except for generated
1383          --  object files (b~.. or B__..) from extended projects.
1384          --  When there are one or more extended files, only add an object file
1385          --  if no object file with the same name have already been added.
1386
1387          In_Main_Object_Directory := True;
1388
1389          --  For gnatmake, when the project specifies more than just Ada as a
1390          --  language (even if course we could not find any source file for
1391          --  the other languages), we will take all object files found in the
1392          --  object directories. Since we know the project supports at least
1393          --  Ada, we just have to test whether it has at least two languages,
1394          --  and not care about the sources.
1395
1396          Foreign_Sources := For_Project.Languages.Next /= null;
1397          Current_Proj := For_Project;
1398          loop
1399             if Current_Proj.Object_Directory /= No_Path_Information then
1400
1401                --  The following code gets far too indented ... suggest some
1402                --  procedural abstraction here. How about making this declare
1403                --  block a named procedure???
1404
1405                declare
1406                   Object_Dir_Path : constant String :=
1407                                       Get_Name_String
1408                                         (Current_Proj.Object_Directory
1409                                          .Display_Name);
1410
1411                   Object_Dir : Dir_Type;
1412                   Filename   : String (1 .. 255);
1413                   Last       : Natural;
1414                   Id         : Name_Id;
1415
1416                begin
1417                   Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path);
1418
1419                   --  For all entries in the object directory
1420
1421                   loop
1422                      Read (Object_Dir, Filename, Last);
1423
1424                      exit when Last = 0;
1425
1426                      --  Check if it is an object file
1427
1428                      if Is_Obj (Filename (1 .. Last)) then
1429                         declare
1430                            Object_Path  : constant String :=
1431                                             Normalize_Pathname
1432                                               (Object_Dir_Path
1433                                                & Directory_Separator
1434                                                & Filename (1 .. Last));
1435                            Object_File  : constant String :=
1436                                             Filename (1 .. Last);
1437
1438                            C_Filename    : String := Object_File;
1439
1440                         begin
1441                            Canonical_Case_File_Name (C_Filename);
1442
1443                            --  If in the object directory of an extended
1444                            --  project, do not consider generated object files.
1445
1446                            if In_Main_Object_Directory
1447                              or else Last < 5
1448                              or else
1449                                C_Filename (1 .. B_Start'Length) /= B_Start.all
1450                            then
1451                               Name_Len := 0;
1452                               Add_Str_To_Name_Buffer (C_Filename);
1453                               Id := Name_Find;
1454
1455                               if not Objects_Htable.Get (Id) then
1456                                  declare
1457                                     ALI_File : constant String :=
1458                                                  Ext_To (C_Filename, "ali");
1459
1460                                     ALI_Path : constant String :=
1461                                                  Ext_To (Object_Path, "ali");
1462
1463                                     Add_It : Boolean;
1464                                     Fname  : File_Name_Type;
1465                                     Proj   : Project_Id;
1466                                     Index  : Unit_Index;
1467
1468                                  begin
1469                                     --  The following assignment could use
1470                                     --  a comment ???
1471
1472                                     Add_It :=
1473                                       Foreign_Sources
1474                                         or else
1475                                           (Last >= 5
1476                                              and then
1477                                                C_Filename (1 .. B_Start'Length)
1478                                                  = B_Start.all);
1479
1480                                     if Is_Regular_File (ALI_Path) then
1481
1482                                        --  If there is an ALI file, check if
1483                                        --  the object file should be added to
1484                                        --  the library. If there are foreign
1485                                        --  sources we put all object files in
1486                                        --  the library.
1487
1488                                        if not Add_It then
1489                                           Index :=
1490                                             Units_Htable.Get_First
1491                                              (In_Tree.Units_HT);
1492                                           while Index /= null loop
1493                                              if Index.File_Names (Impl) /=
1494                                                null
1495                                              then
1496                                                 Proj :=
1497                                                   Index.File_Names (Impl)
1498                                                   .Project;
1499                                                 Fname :=
1500                                                   Index.File_Names (Impl).File;
1501
1502                                              elsif Index.File_Names (Spec) /=
1503                                                null
1504                                              then
1505                                                 Proj :=
1506                                                   Index.File_Names (Spec)
1507                                                   .Project;
1508                                                 Fname :=
1509                                                   Index.File_Names (Spec).File;
1510
1511                                              else
1512                                                 Proj := No_Project;
1513                                              end if;
1514
1515                                              Add_It := Proj /= No_Project;
1516
1517                                              --  If the source is in the
1518                                              --  project or a project it
1519                                              --  extends, we may put it in
1520                                              --  the library.
1521
1522                                              if Add_It then
1523                                                 Add_It := Check_Project (Proj);
1524                                              end if;
1525
1526                                              --  But we don't, if the ALI file
1527                                              --  does not correspond to the
1528                                              --  unit.
1529
1530                                              if Add_It then
1531                                                 declare
1532                                                    F : constant String :=
1533                                                          Ext_To
1534                                                            (Get_Name_String
1535                                                               (Fname), "ali");
1536                                                 begin
1537                                                    Add_It := F = ALI_File;
1538                                                 end;
1539                                              end if;
1540
1541                                              exit when Add_It;
1542
1543                                              Index :=
1544                                                Units_Htable.Get_Next
1545                                                  (In_Tree.Units_HT);
1546                                           end loop;
1547                                        end if;
1548
1549                                        if Add_It then
1550                                           Objects_Htable.Set (Id, True);
1551                                           Objects.Append
1552                                             (new String'(Object_Path));
1553
1554                                           --  Record the ALI file
1555
1556                                           ALIs.Append (new String'(ALI_Path));
1557
1558                                           --  Find out if for this ALI file,
1559                                           --  libgnarl or libdecgnat or
1560                                           --  g-trasym.obj (on OpenVMS) is
1561                                           --  necessary.
1562
1563                                           Check_Libs (ALI_Path, True);
1564                                        end if;
1565
1566                                     elsif Foreign_Sources then
1567                                        Objects.Append
1568                                          (new String'(Object_Path));
1569                                     end if;
1570                                  end;
1571                               end if;
1572                            end if;
1573                         end;
1574                      end if;
1575                   end loop;
1576
1577                   Close (Dir => Object_Dir);
1578
1579                exception
1580                   when Directory_Error =>
1581                      Com.Fail ("cannot find object directory """
1582                                & Get_Name_String
1583                                   (Current_Proj.Object_Directory.Display_Name)
1584                                & """");
1585                end;
1586             end if;
1587
1588             exit when Current_Proj.Extends = No_Project;
1589
1590             In_Main_Object_Directory  := False;
1591             Current_Proj := Current_Proj.Extends;
1592          end loop;
1593
1594          --  Add the -L and -l switches for the imported Library Project Files,
1595          --  and, if Path Option is supported, the library directory path names
1596          --  to Rpath.
1597
1598          Process_Imported_Libraries;
1599
1600          --  Link with libgnat and possibly libgnarl
1601
1602          Opts.Increment_Last;
1603          Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory);
1604
1605          --  If Path Option supported, add libgnat directory path name to Rpath
1606
1607          if Path_Option /= null then
1608             declare
1609                Libdir    : constant String := Lib_Directory;
1610                GCC_Index : Natural := 0;
1611
1612             begin
1613                Add_Rpath (Libdir);
1614
1615                --  For shared libraries, add to the Path Option the directory
1616                --  of the shared version of libgcc.
1617
1618                if The_Build_Mode /= Static then
1619                   GCC_Index := Index (Libdir, "/lib/");
1620
1621                   if GCC_Index = 0 then
1622                      GCC_Index :=
1623                        Index
1624                          (Libdir,
1625                           Directory_Separator & "lib" & Directory_Separator);
1626                   end if;
1627
1628                   if GCC_Index /= 0 then
1629                      Add_Rpath (Libdir (Libdir'First .. GCC_Index + 3));
1630                   end if;
1631                end if;
1632             end;
1633          end if;
1634
1635          if Libgnarl_Needed = Yes then
1636             Opts.Increment_Last;
1637
1638             if The_Build_Mode = Static then
1639                Opts.Table (Opts.Last) := new String'("-lgnarl");
1640             else
1641                Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnarl"));
1642             end if;
1643          end if;
1644
1645          if Gtrasymobj_Needed then
1646             Opts.Increment_Last;
1647             Opts.Table (Opts.Last) :=
1648               new String'(Lib_Directory & "/g-trasym.obj");
1649          end if;
1650
1651          if Libdecgnat_Needed then
1652             Opts.Increment_Last;
1653
1654             Opts.Table (Opts.Last) :=
1655               new String'("-L" & Lib_Directory & "/../declib");
1656
1657             Opts.Increment_Last;
1658
1659             if The_Build_Mode = Static then
1660                Opts.Table (Opts.Last) := new String'("-ldecgnat");
1661             else
1662                Opts.Table (Opts.Last) := new String'(Shared_Lib ("decgnat"));
1663             end if;
1664          end if;
1665
1666          Opts.Increment_Last;
1667
1668          if The_Build_Mode = Static then
1669             Opts.Table (Opts.Last) := new String'("-lgnat");
1670          else
1671             Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnat"));
1672          end if;
1673
1674          --  If Path Option is supported, add the necessary switch with the
1675          --  content of Rpath. As Rpath contains at least libgnat directory
1676          --  path name, it is guaranteed that it is not null.
1677
1678          if Path_Option /= null then
1679             Opts.Increment_Last;
1680             Opts.Table (Opts.Last) :=
1681               new String'(Path_Option.all & Rpath (1 .. Rpath_Last));
1682             Free (Path_Option);
1683             Free (Rpath);
1684          end if;
1685
1686          Object_Files :=
1687            new Argument_List'
1688              (Argument_List (Objects.Table (1 .. Objects.Last)));
1689
1690          Ali_Files :=
1691            new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
1692
1693          Options :=
1694            new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
1695
1696          --  We fail if there are no object to put in the library
1697          --  (Ada or foreign objects).
1698
1699          if Object_Files'Length = 0 then
1700             Com.Fail ("no object files for library """ &
1701                       Lib_Filename.all & '"');
1702          end if;
1703
1704          if not Opt.Quiet_Output then
1705             Write_Eol;
1706             Write_Str  ("building ");
1707             Write_Str (Ada.Characters.Handling.To_Lower
1708                          (Build_Mode_State'Image (The_Build_Mode)));
1709             Write_Str  (" library for project ");
1710             Write_Line (Project_Name);
1711
1712             --  Only output list of object files and ALI files in verbose mode
1713
1714             if Opt.Verbose_Mode then
1715                Write_Eol;
1716
1717                Write_Line ("object files:");
1718
1719                for Index in Object_Files'Range loop
1720                   Write_Str  ("   ");
1721                   Write_Line (Object_Files (Index).all);
1722                end loop;
1723
1724                Write_Eol;
1725
1726                if Ali_Files'Length = 0 then
1727                   Write_Line ("NO ALI files");
1728
1729                else
1730                   Write_Line ("ALI files:");
1731
1732                   for Index in Ali_Files'Range loop
1733                      Write_Str  ("   ");
1734                      Write_Line (Ali_Files (Index).all);
1735                   end loop;
1736                end if;
1737
1738                Write_Eol;
1739             end if;
1740          end if;
1741
1742          --  We check that all object files are regular files
1743
1744          Check_Context;
1745
1746          --  Delete the existing library file, if it exists. Fail if the
1747          --  library file is not writable, or if it is not possible to delete
1748          --  the file.
1749
1750          declare
1751             DLL_Name : aliased String :=
1752                          Lib_Dirpath.all & Directory_Separator & DLL_Prefix &
1753                            Lib_Filename.all & "." & DLL_Ext;
1754
1755             Archive_Name : aliased String :=
1756                              Lib_Dirpath.all & Directory_Separator & "lib" &
1757                                Lib_Filename.all & "." & Archive_Ext;
1758
1759             type Str_Ptr is access all String;
1760             --  This type is necessary to meet the accessibility rules of Ada.
1761             --  It is not possible to use String_Access here.
1762
1763             Full_Lib_Name : Str_Ptr;
1764             --  Designates the full library path name. Either DLL_Name or
1765             --  Archive_Name, depending on the library kind.
1766
1767             Success : Boolean;
1768             pragma Warnings (Off, Success);
1769             --  Used to call Delete_File
1770
1771          begin
1772             if The_Build_Mode = Static then
1773                Full_Lib_Name := Archive_Name'Access;
1774             else
1775                Full_Lib_Name := DLL_Name'Access;
1776             end if;
1777
1778             if Is_Regular_File (Full_Lib_Name.all) then
1779                if Is_Writable_File (Full_Lib_Name.all) then
1780                   Delete_File (Full_Lib_Name.all, Success);
1781                end if;
1782
1783                if Is_Regular_File (Full_Lib_Name.all) then
1784                   Com.Fail ("could not delete """ & Full_Lib_Name.all & """");
1785                end if;
1786             end if;
1787          end;
1788
1789          Argument_Number := 0;
1790
1791          --  If we have a standalone library, gather all the interface ALI.
1792          --  They are passed to Build_Dynamic_Library, where they are used by
1793          --  some platforms (VMS, for example) to decide what symbols should be
1794          --  exported. They are also flagged as Interface when we copy them to
1795          --  the library directory (by Copy_ALI_Files, below).
1796
1797          if Standalone then
1798             Current_Proj := For_Project;
1799
1800             declare
1801                Iface : String_List_Id := For_Project.Lib_Interface_ALIs;
1802                ALI   : File_Name_Type;
1803
1804             begin
1805                while Iface /= Nil_String loop
1806                   ALI :=
1807                     File_Name_Type
1808                       (In_Tree.Shared.String_Elements.Table (Iface).Value);
1809                   Interface_ALIs.Set (ALI, True);
1810                   Get_Name_String
1811                     (In_Tree.Shared.String_Elements.Table (Iface).Value);
1812                   Add_Argument (Name_Buffer (1 .. Name_Len));
1813                   Iface := In_Tree.Shared.String_Elements.Table (Iface).Next;
1814                end loop;
1815
1816                Iface := For_Project.Lib_Interface_ALIs;
1817
1818                if not Opt.Quiet_Output then
1819
1820                   --  Check that the interface set is complete: any unit in the
1821                   --  library that is needed by an interface should also be an
1822                   --  interface. If it is not the case, output a warning.
1823
1824                   while Iface /= Nil_String loop
1825                      ALI :=
1826                        File_Name_Type
1827                          (In_Tree.Shared.String_Elements.Table (Iface).Value);
1828                      Process (ALI);
1829                      Iface :=
1830                        In_Tree.Shared.String_Elements.Table (Iface).Next;
1831                   end loop;
1832                end if;
1833             end;
1834          end if;
1835
1836          declare
1837             Current_Dir  : constant String := Get_Current_Dir;
1838             Dir          : Dir_Type;
1839
1840             Name : String (1 .. 200);
1841             Last : Natural;
1842
1843             Disregard : Boolean;
1844             pragma Warnings (Off, Disregard);
1845
1846             DLL_Name : aliased constant String :=
1847                          Lib_Filename.all & "." & DLL_Ext;
1848
1849             Archive_Name : aliased constant String :=
1850                              Lib_Filename.all & "." & Archive_Ext;
1851
1852             Delete : Boolean := False;
1853
1854          begin
1855             --  Clean the library directory: remove any file with the name of
1856             --  the library file and any ALI file of a source of the project.
1857
1858             begin
1859                Get_Name_String (For_Project.Library_Dir.Display_Name);
1860                Change_Dir (Name_Buffer (1 .. Name_Len));
1861
1862             exception
1863                when others =>
1864                   Com.Fail
1865                     ("unable to access library directory """
1866                      & Name_Buffer (1 .. Name_Len)
1867                      & """");
1868             end;
1869
1870             Open (Dir, ".");
1871
1872             loop
1873                Read (Dir, Name, Last);
1874                exit when Last = 0;
1875
1876                declare
1877                   Filename : constant String := Name (1 .. Last);
1878
1879                begin
1880                   if Is_Regular_File (Filename) then
1881                      Canonical_Case_File_Name (Name (1 .. Last));
1882                      Delete := False;
1883
1884                      if (The_Build_Mode = Static
1885                           and then Name (1 .. Last) =  Archive_Name)
1886                        or else
1887                          ((The_Build_Mode = Dynamic
1888                             or else
1889                            The_Build_Mode = Relocatable)
1890                           and then Name (1 .. Last) = DLL_Name)
1891                      then
1892                         Delete := True;
1893
1894                      elsif Last > 4
1895                        and then Name (Last - 3 .. Last) = ".ali"
1896                      then
1897                         declare
1898                            Unit : Unit_Index;
1899
1900                         begin
1901                            --  Compare with ALI file names of the project
1902
1903                            Unit := Units_Htable.Get_First (In_Tree.Units_HT);
1904                            while Unit /= No_Unit_Index loop
1905                               if Unit.File_Names (Impl) /= null
1906                                 and then Unit.File_Names (Impl).Project /=
1907                                                                  No_Project
1908                               then
1909                                  if Ultimate_Extending_Project_Of
1910                                       (Unit.File_Names (Impl).Project) =
1911                                                                  For_Project
1912                                  then
1913                                     Get_Name_String
1914                                       (Unit.File_Names (Impl).File);
1915                                     Name_Len :=
1916                                       Name_Len -
1917                                         File_Extension
1918                                           (Name (1 .. Name_Len))'Length;
1919
1920                                     if Name_Buffer (1 .. Name_Len) =
1921                                       Name (1 .. Last - 4)
1922                                     then
1923                                        Delete := True;
1924                                        exit;
1925                                     end if;
1926                                  end if;
1927
1928                               elsif Unit.File_Names (Spec) /= null
1929                                 and then Ultimate_Extending_Project_Of
1930                                            (Unit.File_Names (Spec).Project) =
1931                                                                    For_Project
1932                               then
1933                                  Get_Name_String (Unit.File_Names (Spec).File);
1934                                  Name_Len :=
1935                                    Name_Len -
1936                                      File_Extension (Name (1 .. Last))'Length;
1937
1938                                  if Name_Buffer (1 .. Name_Len) =
1939                                       Name (1 .. Last - 4)
1940                                  then
1941                                     Delete := True;
1942                                     exit;
1943                                  end if;
1944                               end if;
1945
1946                               Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
1947                            end loop;
1948                         end;
1949                      end if;
1950
1951                      if Delete then
1952                         Set_Writable (Filename);
1953                         Delete_File (Filename, Disregard);
1954                      end if;
1955                   end if;
1956                end;
1957             end loop;
1958
1959             Close (Dir);
1960
1961             Change_Dir (Current_Dir);
1962          end;
1963
1964          --  Call procedure to build the library, depending on the build mode
1965
1966          case The_Build_Mode is
1967             when Dynamic | Relocatable =>
1968                Build_Dynamic_Library
1969                  (Ofiles        => Object_Files.all,
1970                   Options       => Options.all,
1971                   Interfaces    => Arguments (1 .. Argument_Number),
1972                   Lib_Filename  => Lib_Filename.all,
1973                   Lib_Dir       => Lib_Dirpath.all,
1974                   Symbol_Data   => Current_Proj.Symbol_Data,
1975                   Driver_Name   => Driver_Name,
1976                   Lib_Version   => Lib_Version.all,
1977                   Auto_Init     => Current_Proj.Lib_Auto_Init);
1978
1979             when Static =>
1980                MLib.Build_Library
1981                  (Object_Files.all,
1982                   Lib_Filename.all,
1983                   Lib_Dirpath.all);
1984
1985             when None =>
1986                null;
1987          end case;
1988
1989          --  We need to copy the ALI files from the object directory to the
1990          --  library ALI directory, so that the linker find them there, and
1991          --  does not need to look in the object directory where it would also
1992          --  find the object files; and we don't want that: we want the linker
1993          --  to use the library.
1994
1995          --  Copy the ALI files and make the copies read-only. For interfaces,
1996          --  mark the copies as interfaces.
1997
1998          Copy_ALI_Files
1999            (Files      => Ali_Files.all,
2000             To         => For_Project.Library_ALI_Dir.Display_Name,
2001             Interfaces => Arguments (1 .. Argument_Number));
2002
2003          --  Copy interface sources if Library_Src_Dir specified
2004
2005          if Standalone
2006            and then For_Project.Library_Src_Dir /= No_Path_Information
2007          then
2008             --  Clean the interface copy directory: remove any source that
2009             --  could be a source of the project.
2010
2011             begin
2012                Get_Name_String (For_Project.Library_Src_Dir.Display_Name);
2013                Change_Dir (Name_Buffer (1 .. Name_Len));
2014
2015             exception
2016                when others =>
2017                   Com.Fail
2018                     ("unable to access library source copy directory """
2019                      & Name_Buffer (1 .. Name_Len)
2020                      & """");
2021             end;
2022
2023             declare
2024                Dir    : Dir_Type;
2025                Delete : Boolean := False;
2026                Unit   : Unit_Index;
2027
2028                Name : String (1 .. 200);
2029                Last : Natural;
2030
2031                Disregard : Boolean;
2032                pragma Warnings (Off, Disregard);
2033
2034             begin
2035                Open (Dir, ".");
2036
2037                loop
2038                   Read (Dir, Name, Last);
2039                   exit when Last = 0;
2040
2041                   if Is_Regular_File (Name (1 .. Last)) then
2042                      Canonical_Case_File_Name (Name (1 .. Last));
2043                      Delete := False;
2044
2045                      --  Compare with source file names of the project
2046
2047                      Unit := Units_Htable.Get_First (In_Tree.Units_HT);
2048                      while Unit /= No_Unit_Index loop
2049                         if Unit.File_Names (Impl) /= null
2050                           and then Ultimate_Extending_Project_Of
2051                             (Unit.File_Names (Impl).Project) = For_Project
2052                           and then
2053                             Get_Name_String
2054                               (Unit.File_Names (Impl).File) =
2055                             Name (1 .. Last)
2056                         then
2057                            Delete := True;
2058                            exit;
2059                         end if;
2060
2061                         if Unit.File_Names (Spec) /= null
2062                           and then Ultimate_Extending_Project_Of
2063                             (Unit.File_Names (Spec).Project) =
2064                              For_Project
2065                           and then
2066                            Get_Name_String
2067                              (Unit.File_Names (Spec).File) =
2068                            Name (1 .. Last)
2069                         then
2070                            Delete := True;
2071                            exit;
2072                         end if;
2073
2074                         Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
2075                      end loop;
2076                   end if;
2077
2078                   if Delete then
2079                      Set_Writable (Name (1 .. Last));
2080                      Delete_File (Name (1 .. Last), Disregard);
2081                   end if;
2082                end loop;
2083
2084                Close (Dir);
2085             end;
2086
2087             Copy_Interface_Sources
2088               (For_Project => For_Project,
2089                In_Tree     => In_Tree,
2090                Interfaces  => Arguments (1 .. Argument_Number),
2091                To_Dir      => For_Project.Library_Src_Dir.Display_Name);
2092          end if;
2093       end if;
2094
2095       --  Reset the current working directory to its previous value
2096
2097       Change_Dir (Current_Dir);
2098    end Build_Library;
2099
2100    -----------
2101    -- Check --
2102    -----------
2103
2104    procedure Check (Filename : String) is
2105    begin
2106       if not Is_Regular_File (Filename) then
2107          Com.Fail (Filename & " not found.");
2108       end if;
2109    end Check;
2110
2111    -------------------
2112    -- Check_Context --
2113    -------------------
2114
2115    procedure Check_Context is
2116    begin
2117       --  Check that each object file exists
2118
2119       for F in Object_Files'Range loop
2120          Check (Object_Files (F).all);
2121       end loop;
2122    end Check_Context;
2123
2124    -------------------
2125    -- Check_Library --
2126    -------------------
2127
2128    procedure Check_Library
2129      (For_Project : Project_Id; In_Tree : Project_Tree_Ref)
2130    is
2131       Lib_TS  : Time_Stamp_Type;
2132       Current : constant Dir_Name_Str := Get_Current_Dir;
2133
2134    begin
2135       --  No need to build the library if there is no object directory,
2136       --  hence no object files to build the library.
2137
2138       if For_Project.Library then
2139          declare
2140             Lib_Name : constant File_Name_Type :=
2141                          Library_File_Name_For (For_Project, In_Tree);
2142          begin
2143             Change_Dir
2144               (Get_Name_String (For_Project.Library_Dir.Display_Name));
2145             Lib_TS := File_Stamp (Lib_Name);
2146             For_Project.Library_TS := Lib_TS;
2147          end;
2148
2149          if not For_Project.Externally_Built
2150            and then not For_Project.Need_To_Build_Lib
2151            and then For_Project.Object_Directory /= No_Path_Information
2152          then
2153             declare
2154                Obj_TS     : Time_Stamp_Type;
2155                Object_Dir : Dir_Type;
2156
2157             begin
2158                if OpenVMS_On_Target then
2159                   B_Start := new String'("b__");
2160                end if;
2161
2162                --  If the library file does not exist, then the time stamp will
2163                --  be Empty_Time_Stamp, earlier than any other time stamp.
2164
2165                Change_Dir
2166                  (Get_Name_String (For_Project.Object_Directory.Display_Name));
2167                Open (Dir => Object_Dir, Dir_Name => ".");
2168
2169                --  For all entries in the object directory
2170
2171                loop
2172                   Read (Object_Dir, Name_Buffer, Name_Len);
2173                   exit when Name_Len = 0;
2174
2175                   --  Check if it is an object file, but ignore any binder
2176                   --  generated file.
2177
2178                   if Is_Obj (Name_Buffer (1 .. Name_Len))
2179                     and then Name_Buffer (1 .. B_Start'Length) /= B_Start.all
2180                   then
2181                      --  Get the object file time stamp
2182
2183                      Obj_TS := File_Stamp (File_Name_Type'(Name_Find));
2184
2185                      --  If library file time stamp is earlier, set
2186                      --  Need_To_Build_Lib and return. String comparison is
2187                      --  used, otherwise time stamps may be too close and the
2188                      --  comparison would return True, which would trigger
2189                      --  an unnecessary rebuild of the library.
2190
2191                      if String (Lib_TS) < String (Obj_TS) then
2192
2193                         --  Library must be rebuilt
2194
2195                         For_Project.Need_To_Build_Lib := True;
2196                         exit;
2197                      end if;
2198                   end if;
2199                end loop;
2200
2201                Close (Object_Dir);
2202             end;
2203          end if;
2204
2205          Change_Dir (Current);
2206       end if;
2207    end Check_Library;
2208
2209    ----------------------------
2210    -- Copy_Interface_Sources --
2211    ----------------------------
2212
2213    procedure Copy_Interface_Sources
2214      (For_Project : Project_Id;
2215       In_Tree     : Project_Tree_Ref;
2216       Interfaces  : Argument_List;
2217       To_Dir      : Path_Name_Type)
2218    is
2219       Current : constant Dir_Name_Str := Get_Current_Dir;
2220       --  The current directory, where to return to at the end
2221
2222       Target : constant Dir_Name_Str := Get_Name_String (To_Dir);
2223       --  The directory where to copy sources
2224
2225       Text     : Text_Buffer_Ptr;
2226       The_ALI  : ALI.ALI_Id;
2227       Lib_File : File_Name_Type;
2228
2229       First_Unit  : ALI.Unit_Id;
2230       Second_Unit : ALI.Unit_Id;
2231
2232       Copy_Subunits : Boolean := False;
2233       --  When True, indicates that subunits, if any, need to be copied too
2234
2235       procedure Copy (File_Name : File_Name_Type);
2236       --  Copy one source of the project to the target directory
2237
2238       ----------
2239       -- Copy --
2240       ----------
2241
2242       procedure Copy (File_Name : File_Name_Type) is
2243          Success : Boolean;
2244          pragma Warnings (Off, Success);
2245
2246          Source : Standard.Prj.Source_Id;
2247       begin
2248          Source := Find_Source
2249            (In_Tree, For_Project,
2250             In_Extended_Only => True,
2251             Base_Name => File_Name);
2252
2253          if Source /= No_Source
2254            and then not Source.Locally_Removed
2255            and then Source.Replaced_By = No_Source
2256          then
2257             Copy_File
2258               (Get_Name_String (Source.Path.Name),
2259                Target,
2260                Success,
2261                Mode     => Overwrite,
2262                Preserve => Preserve);
2263          end if;
2264       end Copy;
2265
2266    --  Start of processing for Copy_Interface_Sources
2267
2268    begin
2269       --  Change the working directory to the object directory
2270
2271       Change_Dir (Get_Name_String (For_Project.Object_Directory.Display_Name));
2272
2273       for Index in Interfaces'Range loop
2274
2275          --  First, load the ALI file
2276
2277          Name_Len := 0;
2278          Add_Str_To_Name_Buffer (Interfaces (Index).all);
2279          Lib_File := Name_Find;
2280          Text := Read_Library_Info (Lib_File);
2281          The_ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
2282          Free (Text);
2283
2284          Second_Unit := No_Unit_Id;
2285          First_Unit := ALI.ALIs.Table (The_ALI).First_Unit;
2286          Copy_Subunits := True;
2287
2288          --  If there is both a spec and a body, check if they are both needed
2289
2290          if ALI.Units.Table (First_Unit).Utype = Is_Body then
2291             Second_Unit := ALI.ALIs.Table (The_ALI).Last_Unit;
2292
2293             --  If the body is not needed, then reset First_Unit
2294
2295             if not ALI.Units.Table (Second_Unit).Body_Needed_For_SAL then
2296                First_Unit := No_Unit_Id;
2297                Copy_Subunits := False;
2298             end if;
2299
2300          elsif ALI.Units.Table (First_Unit).Utype = Is_Spec_Only then
2301             Copy_Subunits := False;
2302          end if;
2303
2304          --  Copy the file(s) that need to be copied
2305
2306          if First_Unit /= No_Unit_Id then
2307             Copy (File_Name => ALI.Units.Table (First_Unit).Sfile);
2308          end if;
2309
2310          if Second_Unit /= No_Unit_Id then
2311             Copy (File_Name => ALI.Units.Table (Second_Unit).Sfile);
2312          end if;
2313
2314          --  Copy all the separates, if any
2315
2316          if Copy_Subunits then
2317             for Dep in ALI.ALIs.Table (The_ALI).First_Sdep ..
2318               ALI.ALIs.Table (The_ALI).Last_Sdep
2319             loop
2320                if Sdep.Table (Dep).Subunit_Name /= No_Name then
2321                   Copy (File_Name => Sdep.Table (Dep).Sfile);
2322                end if;
2323             end loop;
2324          end if;
2325       end loop;
2326
2327       --  Restore the initial working directory
2328
2329       Change_Dir (Current);
2330    end Copy_Interface_Sources;
2331
2332    -------------
2333    -- Display --
2334    -------------
2335
2336    procedure Display (Executable : String) is
2337    begin
2338       if not Opt.Quiet_Output then
2339          Write_Str (Executable);
2340
2341          for Index in 1 .. Argument_Number loop
2342             Write_Char (' ');
2343             Write_Str (Arguments (Index).all);
2344
2345             if not Opt.Verbose_Mode and then Index > 4 then
2346                Write_Str (" ...");
2347                exit;
2348             end if;
2349          end loop;
2350
2351          Write_Eol;
2352       end if;
2353    end Display;
2354
2355    -----------
2356    -- Index --
2357    -----------
2358
2359    function Index (S, Pattern : String) return Natural is
2360       Len : constant Natural := Pattern'Length;
2361
2362    begin
2363       for J in reverse S'First .. S'Last - Len + 1 loop
2364          if Pattern = S (J .. J + Len - 1) then
2365             return J;
2366          end if;
2367       end loop;
2368
2369       return 0;
2370    end Index;
2371
2372    -------------------------
2373    -- Process_Binder_File --
2374    -------------------------
2375
2376    procedure Process_Binder_File (Name : String) is
2377       Fd : FILEs;
2378       --  Binder file's descriptor
2379
2380       Read_Mode : constant String := "r" & ASCII.NUL;
2381       --  For fopen
2382
2383       Status : Interfaces.C_Streams.int;
2384       pragma Unreferenced (Status);
2385       --  For fclose
2386
2387       Begin_Info : constant String := "--  BEGIN Object file/option list";
2388       End_Info   : constant String := "--  END Object file/option list   ";
2389
2390       Next_Line : String (1 .. 1000);
2391       --  Current line value
2392       --  Where does this odd constant 1000 come from, looks suspicious ???
2393
2394       Nlast : Integer;
2395       --  End of line slice (the slice does not contain the line terminator)
2396
2397       procedure Get_Next_Line;
2398       --  Read the next line from the binder file without the line terminator
2399
2400       -------------------
2401       -- Get_Next_Line --
2402       -------------------
2403
2404       procedure Get_Next_Line is
2405          Fchars : chars;
2406
2407       begin
2408          Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
2409
2410          if Fchars = System.Null_Address then
2411             Fail ("Error reading binder output");
2412          end if;
2413
2414          Nlast := 1;
2415          while Nlast <= Next_Line'Last
2416            and then Next_Line (Nlast) /= ASCII.LF
2417            and then Next_Line (Nlast) /= ASCII.CR
2418          loop
2419             Nlast := Nlast + 1;
2420          end loop;
2421
2422          Nlast := Nlast - 1;
2423       end Get_Next_Line;
2424
2425    --  Start of processing for Process_Binder_File
2426
2427    begin
2428       Fd := fopen (Name'Address, Read_Mode'Address);
2429
2430       if Fd = NULL_Stream then
2431          Fail ("Failed to open binder output");
2432       end if;
2433
2434       --  Skip up to the Begin Info line
2435
2436       loop
2437          Get_Next_Line;
2438          exit when Next_Line (1 .. Nlast) = Begin_Info;
2439       end loop;
2440
2441       --  Find the first switch
2442
2443       loop
2444          Get_Next_Line;
2445
2446          exit when Next_Line (1 .. Nlast) = End_Info;
2447
2448          --  As the binder generated file is in Ada, remove the first eight
2449          --  characters "   --   ".
2450
2451          Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
2452          Nlast := Nlast - 8;
2453
2454          --  Stop when the first switch is found
2455
2456          exit when Next_Line (1) = '-';
2457       end loop;
2458
2459       if Next_Line (1 .. Nlast) /= End_Info then
2460          loop
2461             --  Ignore -static and -shared, since -shared will be used
2462             --  in any case.
2463
2464             --  Ignore -lgnat, -lgnarl and -ldecgnat as they will be added
2465             --  later, because they are also needed for non Stand-Alone shared
2466             --  libraries.
2467
2468             --  Also ignore the shared libraries which are :
2469
2470             --  UNIX / Windows    VMS
2471             --  -lgnat-<version>  -lgnat_<version>  (7 + version'length chars)
2472             --  -lgnarl-<version> -lgnarl_<version> (8 + version'length chars)
2473
2474             if Next_Line (1 .. Nlast) /= "-static" and then
2475                Next_Line (1 .. Nlast) /= "-shared" and then
2476                Next_Line (1 .. Nlast) /= "-ldecgnat" and then
2477                Next_Line (1 .. Nlast) /= "-lgnarl" and then
2478                Next_Line (1 .. Nlast) /= "-lgnat" and then
2479                Next_Line
2480                  (1 .. Natural'Min (Nlast, 10 + Library_Version'Length)) /=
2481                    Shared_Lib ("decgnat") and then
2482                Next_Line
2483                  (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
2484                    Shared_Lib ("gnarl") and then
2485                Next_Line
2486                  (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /=
2487                    Shared_Lib ("gnat")
2488             then
2489                if Next_Line (1) /= '-' then
2490
2491                   --  This is not an option, should we add it?
2492
2493                   if Add_Object_Files then
2494                      Opts.Increment_Last;
2495                      Opts.Table (Opts.Last) :=
2496                        new String'(Next_Line (1 .. Nlast));
2497                   end if;
2498
2499                else
2500                   --  Add all other options
2501
2502                   Opts.Increment_Last;
2503                   Opts.Table (Opts.Last) :=
2504                     new String'(Next_Line (1 .. Nlast));
2505                end if;
2506             end if;
2507
2508             --  Next option, if any
2509
2510             Get_Next_Line;
2511             exit when Next_Line (1 .. Nlast) = End_Info;
2512
2513             --  Remove first eight characters "   --   "
2514
2515             Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
2516             Nlast := Nlast - 8;
2517          end loop;
2518       end if;
2519
2520       Status := fclose (Fd);
2521
2522       --  Is it really right to ignore any close error ???
2523
2524    end Process_Binder_File;
2525
2526    ------------------
2527    -- Reset_Tables --
2528    ------------------
2529
2530    procedure Reset_Tables is
2531    begin
2532       Objects.Init;
2533       Objects_Htable.Reset;
2534       ALIs.Init;
2535       Opts.Init;
2536       Processed_Projects.Reset;
2537       Library_Projs.Init;
2538    end Reset_Tables;
2539
2540    ---------------------------
2541    -- SALs_Use_Constructors --
2542    ---------------------------
2543
2544    function SALs_Use_Constructors return Boolean is
2545       function C_SALs_Init_Using_Constructors return Integer;
2546       pragma Import (C, C_SALs_Init_Using_Constructors,
2547                      "__gnat_sals_init_using_constructors");
2548    begin
2549       return C_SALs_Init_Using_Constructors /= 0;
2550    end SALs_Use_Constructors;
2551
2552 end MLib.Prj;