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