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