gcc/ada/mlib-prj.adb

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