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