gcc/ada/mlib-prj.adb

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