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