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