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