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          pragma Warnings (Off, Id);
 508          --  Comment needed ???
 509
 510       begin
 511          if not Libgnarl_Needed or
 512            (Hostparm.OpenVMS and then (not Libdecgnat_Needed))
 513          then
 514             --  Scan the ALI file
 515
 516             Name_Len := ALI_File'Length;
 517             Name_Buffer (1 .. Name_Len) := ALI_File;
 518             Lib_File := Name_Find;
 519             Text := Read_Library_Info (Lib_File, True);
 520
 521             Id  := ALI.Scan_ALI
 522                          (F          => Lib_File,
 523                           T          => Text,
 524                           Ignore_ED  => False,
 525                           Err        => True,
 526                           Read_Lines => "D");
 527             Free (Text);
 528
 529             --  Look for s-osinte.ads in the dependencies
 530
 531             for Index in ALI.ALIs.Table (Id).First_Sdep ..
 532                          ALI.ALIs.Table (Id).Last_Sdep
 533             loop
 534                if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
 535                   Libgnarl_Needed := True;
 536
 537                elsif Hostparm.OpenVMS and then
 538                      ALI.Sdep.Table (Index).Sfile = S_Dec_Ads
 539                then
 540                   Libdecgnat_Needed := True;
 541                end if;
 542             end loop;
 543          end if;
 544       end Check_Libs;
 545
 546       -------------
 547       -- Process --
 548       -------------
 549
 550       procedure Process (The_ALI : File_Name_Type) is
 551          Text       : Text_Buffer_Ptr;
 552          Idread     : ALI_Id;
 553          First_Unit : ALI.Unit_Id;
 554          Last_Unit  : ALI.Unit_Id;
 555          Unit_Data  : Unit_Record;
 556          Afile      : File_Name_Type;
 557
 558       begin
 559          --  Nothing to do if the ALI file has already been processed.
 560          --  This happens if an interface imports another interface.
 561
 562          if not Processed_ALIs.Get (The_ALI) then
 563             Processed_ALIs.Set (The_ALI, True);
 564             Text := Read_Library_Info (The_ALI);
 565
 566             if Text /= null then
 567                Idread :=
 568                  Scan_ALI
 569                    (F         => The_ALI,
 570                     T         => Text,
 571                     Ignore_ED => False,
 572                     Err       => True);
 573                Free (Text);
 574
 575                if Idread /= No_ALI_Id then
 576                   First_Unit := ALI.ALIs.Table (Idread).First_Unit;
 577                   Last_Unit  := ALI.ALIs.Table (Idread).Last_Unit;
 578
 579                   --  Process both unit (spec and body) if the body is needed
 580                   --  by the spec (inline or generic). Otherwise, just process
 581                   --  the spec.
 582
 583                   if First_Unit /= Last_Unit and then
 584                     not ALI.Units.Table (Last_Unit).Body_Needed_For_SAL
 585                   then
 586                      First_Unit := Last_Unit;
 587                   end if;
 588
 589                   for Unit in First_Unit .. Last_Unit loop
 590                      Unit_Data := ALI.Units.Table (Unit);
 591
 592                      --  Check if each withed unit which is in the library is
 593                      --  also in the interface set, if it has not yet been
 594                      --  processed.
 595
 596                      for W in Unit_Data.First_With .. Unit_Data.Last_With loop
 597                         Afile := Withs.Table (W).Afile;
 598
 599                         if Afile /= No_Name and then Library_ALIs.Get (Afile)
 600                           and then not Processed_ALIs.Get (Afile)
 601                         then
 602                            if not Interface_ALIs.Get (Afile) then
 603                               if not Warning_For_Library then
 604                                  Write_Str ("Warning: In library project """);
 605                                  Get_Name_String (Data.Name);
 606                                  To_Mixed (Name_Buffer (1 .. Name_Len));
 607                                  Write_Str (Name_Buffer (1 .. Name_Len));
 608                                  Write_Line ("""");
 609                                  Warning_For_Library := True;
 610                               end if;
 611
 612                               Write_Str ("         Unit """);
 613                               Get_Name_String (Withs.Table (W).Uname);
 614                               To_Mixed (Name_Buffer (1 .. Name_Len - 2));
 615                               Write_Str (Name_Buffer (1 .. Name_Len - 2));
 616                               Write_Line (""" is not in the interface set");
 617                               Write_Str ("         but it is needed by ");
 618
 619                               case Unit_Data.Utype is
 620                                  when Is_Spec =>
 621                                     Write_Str ("the spec of ");
 622
 623                                  when Is_Body =>
 624                                     Write_Str ("the body of ");
 625
 626                                  when others =>
 627                                     null;
 628                               end case;
 629
 630                               Write_Str ("""");
 631                               Get_Name_String (Unit_Data.Uname);
 632                               To_Mixed (Name_Buffer (1 .. Name_Len - 2));
 633                               Write_Str (Name_Buffer (1 .. Name_Len - 2));
 634                               Write_Line ("""");
 635                            end if;
 636
 637                            --  Now, process this unit
 638
 639                            Process (Afile);
 640                         end if;
 641                      end loop;
 642                   end loop;
 643                end if;
 644             end if;
 645          end if;
 646       end Process;
 647
 648       --------------------------------
 649       -- Process_Imported_Libraries --
 650       --------------------------------
 651
 652       procedure Process_Imported_Libraries is
 653          Current : Project_Id;
 654
 655          procedure Process_Project (Project : Project_Id);
 656          --  Process Project and its imported projects recursively.
 657          --  Add any library projects to table Library_Projs.
 658
 659          ---------------------
 660          -- Process_Project --
 661          ---------------------
 662
 663          procedure Process_Project (Project : Project_Id) is
 664             Data     : constant Project_Data := Projects.Table (Project);
 665             Imported : Project_List := Data.Imported_Projects;
 666             Element  : Project_Element;
 667
 668          begin
 669             --  Nothing to do if process has already been processed
 670
 671             if not Processed_Projects.Get (Data.Name) then
 672                Processed_Projects.Set (Data.Name, True);
 673
 674                --  If it is a library project, add it to Library_Projs
 675
 676                if Project /= For_Project and then Data.Library then
 677                   Library_Projs.Increment_Last;
 678                   Library_Projs.Table (Library_Projs.Last) := Project;
 679                end if;
 680
 681                --  Call Process_Project recursively for any imported project
 682
 683                while Imported /= Empty_Project_List loop
 684                   Element := Project_Lists.Table (Imported);
 685
 686                   if Element.Project /= No_Project then
 687                      Process_Project (Element.Project);
 688                   end if;
 689
 690                   Imported := Element.Next;
 691                end loop;
 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
 700          Process_Project (For_Project);
 701
 702          --  If there are more that one library project file, make sure
 703          --  that if libA depends on libB, libB is first in order.
 704
 705          if Library_Projs.Last > 1 then
 706             declare
 707                Index : Integer := 1;
 708                Proj1 : Project_Id;
 709                Proj2 : Project_Id;
 710                List  : Project_List := Empty_Project_List;
 711
 712             begin
 713                Library_Loop : while Index < Library_Projs.Last loop
 714                   Proj1 := Library_Projs.Table (Index);
 715                   List  := Projects.Table (Proj1).Imported_Projects;
 716
 717                   List_Loop : while List /= Empty_Project_List loop
 718                      Proj2 := Project_Lists.Table (List).Project;
 719
 720                      for J in Index + 1 .. Library_Projs.Last loop
 721                         if Proj2 = Library_Projs.Table (J) then
 722                            Library_Projs.Table (J) := Proj1;
 723                            Library_Projs.Table (Index) := Proj2;
 724                            exit List_Loop;
 725                         end if;
 726                      end loop;
 727
 728                      List := Project_Lists.Table (List).Next;
 729                   end loop List_Loop;
 730
 731                   if List = Empty_Project_List then
 732                      Index := Index + 1;
 733                   end if;
 734                end loop Library_Loop;
 735             end;
 736          end if;
 737
 738          --  Now that we have a correct order, add the -L and -l switches and,
 739          --  if the Rpath option is supported, add the directory to the Rpath.
 740
 741          for Index in 1 .. Library_Projs.Last loop
 742             Current := Library_Projs.Table (Index);
 743
 744             Opts.Increment_Last;
 745             Opts.Table (Opts.Last) :=
 746               new String'
 747                 ("-L" &
 748                  Get_Name_String
 749                    (Projects.Table (Current).Library_Dir));
 750
 751             if Path_Option /= null then
 752                Add_Rpath
 753                   (Get_Name_String
 754                      (Projects.Table (Current).Library_Dir));
 755             end if;
 756
 757             Opts.Increment_Last;
 758             Opts.Table (Opts.Last) :=
 759               new String'
 760                 ("-l" &
 761                  Get_Name_String
 762                    (Projects.Table (Current).Library_Name));
 763          end loop;
 764       end Process_Imported_Libraries;
 765
 766    --  Start of processing for Build_Library
 767
 768    begin
 769       Reset_Tables;
 770
 771       --  Fail if project is not a library project
 772
 773       if not Data.Library then
 774          Com.Fail ("project """, Project_Name, """ has no library");
 775       end if;
 776
 777       --  If this is the first time Build_Library is called, get the Name_Id
 778       --  of "s-osinte.ads".
 779
 780       if S_Osinte_Ads = No_Name then
 781          Name_Len := 12;
 782          Name_Buffer (1 .. Name_Len) := "s-osinte.ads";
 783          S_Osinte_Ads := Name_Find;
 784       end if;
 785
 786       if S_Dec_Ads = No_Name then
 787          Name_Len := 7;
 788          Name_Buffer (1 .. Name_Len) := "dec.ads";
 789          S_Dec_Ads := Name_Find;
 790       end if;
 791
 792       --  We work in the object directory
 793
 794       Change_Dir (Object_Directory_Path);
 795
 796       if Standalone then
 797          --  Call gnatbind only if Bind is True
 798
 799          if Bind then
 800             if Gnatbind_Path = null then
 801                Com.Fail ("unable to locate ", Gnatbind);
 802             end if;
 803
 804             if Gcc_Path = null then
 805                Com.Fail ("unable to locate ", Gcc);
 806             end if;
 807
 808             --  Allocate Arguments, if it is the first time we see a standalone
 809             --  library.
 810
 811             if Arguments = No_Argument then
 812                Arguments := new String_List (1 .. Initial_Argument_Max);
 813             end if;
 814
 815             --  Add "-n -o b~<lib>.adb (b$<lib>.adb on VMS) -L<lib>"
 816
 817             Argument_Number := 2;
 818             Arguments (1) := No_Main;
 819             Arguments (2) := Output_Switch;
 820
 821             if Hostparm.OpenVMS then
 822                B_Start (B_Start'Last) := '$';
 823             end if;
 824
 825             Add_Argument
 826               (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
 827             Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
 828
 829             --  Check if Binder'Default_Switches ("Ada) is defined. If it is,
 830             --  add these switches to call gnatbind.
 831
 832             declare
 833                Binder_Package : constant Package_Id :=
 834                                   Value_Of
 835                                     (Name        => Name_Binder,
 836                                      In_Packages => Data.Decl.Packages);
 837
 838             begin
 839                if Binder_Package /= No_Package then
 840                   declare
 841                      Defaults : constant Array_Element_Id :=
 842                                   Value_Of
 843                                     (Name      => Name_Default_Switches,
 844                                      In_Arrays =>
 845                                        Packages.Table
 846                                          (Binder_Package).Decl.Arrays);
 847                      Switches : Variable_Value := Nil_Variable_Value;
 848
 849                      Switch : String_List_Id := Nil_String;
 850
 851                   begin
 852                      if Defaults /= No_Array_Element then
 853                         Switches :=
 854                           Value_Of
 855                             (Index => Name_Ada, In_Array => Defaults);
 856
 857                         if not Switches.Default then
 858                            Switch := Switches.Values;
 859
 860                            while Switch /= Nil_String loop
 861                               Add_Argument
 862                                 (Get_Name_String
 863                                    (String_Elements.Table (Switch).Value));
 864                               Switch := String_Elements.Table (Switch).Next;
 865                            end loop;
 866                         end if;
 867                      end if;
 868                   end;
 869                end if;
 870             end;
 871          end if;
 872
 873          --  Get all the ALI files of the project file. We do that even if
 874          --  Bind is False, so that First_ALI is set.
 875
 876          declare
 877             Unit : Unit_Data;
 878
 879          begin
 880             Library_ALIs.Reset;
 881             Interface_ALIs.Reset;
 882             Processed_ALIs.Reset;
 883
 884             for Source in 1 .. Com.Units.Last loop
 885                Unit := Com.Units.Table (Source);
 886
 887                if Unit.File_Names (Body_Part).Name /= No_Name
 888                  and then Unit.File_Names (Body_Part).Path /= Slash
 889                then
 890                   if
 891                     Check_Project (Unit.File_Names (Body_Part).Project)
 892                   then
 893                      if Unit.File_Names (Specification).Name = No_Name then
 894                         declare
 895                            Src_Ind : Source_File_Index;
 896
 897                         begin
 898                            Src_Ind := Sinput.P.Load_Project_File
 899                              (Get_Name_String
 900                                 (Unit.File_Names
 901                                    (Body_Part).Path));
 902
 903                            --  Add the ALI file only if it is not a subunit
 904
 905                            if
 906                            not Sinput.P.Source_File_Is_Subunit (Src_Ind)
 907                            then
 908                               Add_ALI_For
 909                                 (Unit.File_Names (Body_Part).Name);
 910                               exit when not Bind;
 911                            end if;
 912                         end;
 913
 914                      else
 915                         Add_ALI_For (Unit.File_Names (Body_Part).Name);
 916                         exit when not Bind;
 917                      end if;
 918                   end if;
 919
 920                elsif Unit.File_Names (Specification).Name /= No_Name
 921                  and then Unit.File_Names (Specification).Path /= Slash
 922                  and then Check_Project
 923                    (Unit.File_Names (Specification).Project)
 924                then
 925                   Add_ALI_For (Unit.File_Names (Specification).Name);
 926                   exit when not Bind;
 927                end if;
 928             end loop;
 929          end;
 930
 931          --  Continue setup and call gnatbind if Bind is True
 932
 933          if Bind then
 934
 935             --  Get an eventual --RTS from the ALI file
 936
 937             if First_ALI /= No_Name then
 938                declare
 939                   use Types;
 940                   T : Text_Buffer_Ptr;
 941                   A : ALI_Id;
 942
 943                begin
 944                   --  Load the ALI file
 945
 946                   T := Read_Library_Info (First_ALI, True);
 947
 948                   --  Read it
 949
 950                   A := Scan_ALI
 951                          (First_ALI, T, Ignore_ED => False, Err => False);
 952
 953                   if A /= No_ALI_Id then
 954                      for Index in
 955                        ALI.Units.Table
 956                          (ALI.ALIs.Table (A).First_Unit).First_Arg ..
 957                        ALI.Units.Table
 958                          (ALI.ALIs.Table (A).First_Unit).Last_Arg
 959                      loop
 960                         --  Look for --RTS. If found, add the switch to call
 961                         --  gnatbind.
 962
 963                         declare
 964                            Arg : String_Ptr renames Args.Table (Index);
 965                         begin
 966                            if
 967                              Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
 968                            then
 969                               Add_Argument (Arg.all);
 970                               exit;
 971                            end if;
 972                         end;
 973                      end loop;
 974                   end if;
 975                end;
 976             end if;
 977
 978             --  Set the paths
 979
 980             Set_Ada_Paths
 981               (Project => For_Project, Including_Libraries => True);
 982
 983             --  Display the gnatbind command, if not in quiet output
 984
 985             Display (Gnatbind);
 986
 987             --  Invoke gnatbind
 988
 989             GNAT.OS_Lib.Spawn
 990               (Gnatbind_Path.all, Arguments (1 .. Argument_Number), Success);
 991
 992             if not Success then
 993                Com.Fail ("could not bind standalone library ",
 994                          Get_Name_String (Data.Library_Name));
 995             end if;
 996          end if;
 997
 998          --  Compile the binder generated file only if Link is true
 999
1000          if Link then
1001             --  Set the paths
1002
1003             Set_Ada_Paths
1004               (Project => For_Project, Including_Libraries => True);
1005
1006             --  Invoke <gcc> -c b$$<lib>.adb
1007
1008             --  Allocate Arguments, if it is the first time we see a standalone
1009             --  library.
1010
1011             if Arguments = No_Argument then
1012                Arguments := new String_List (1 .. Initial_Argument_Max);
1013             end if;
1014
1015             Argument_Number := 1;
1016             Arguments (1) := Compile_Switch;
1017
1018             if Hostparm.OpenVMS then
1019                B_Start (B_Start'Last) := '$';
1020             end if;
1021
1022             Add_Argument
1023               (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
1024
1025             --  If necessary, add the PIC option
1026
1027             if PIC_Option /= "" then
1028                Add_Argument (PIC_Option);
1029             end if;
1030
1031             --  Get the back-end switches and --RTS from the ALI file
1032
1033             if First_ALI /= No_Name then
1034                declare
1035                   use Types;
1036                   T : Text_Buffer_Ptr;
1037                   A : ALI_Id;
1038
1039                begin
1040                   --  Load the ALI file
1041
1042                   T := Read_Library_Info (First_ALI, True);
1043
1044                   --  Read it
1045
1046                   A := Scan_ALI
1047                          (First_ALI, T, Ignore_ED => False, Err => False);
1048
1049                   if A /= No_ALI_Id then
1050                      for Index in
1051                        ALI.Units.Table
1052                          (ALI.ALIs.Table (A).First_Unit).First_Arg ..
1053                        ALI.Units.Table
1054                          (ALI.ALIs.Table (A).First_Unit).Last_Arg
1055                      loop
1056                         --  Do not compile with the front end switches except
1057                         --  for --RTS.
1058
1059                         declare
1060                            Arg : String_Ptr renames Args.Table (Index);
1061                         begin
1062                            if not Is_Front_End_Switch (Arg.all)
1063                              or else
1064                                Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
1065                            then
1066                               Add_Argument (Arg.all);
1067                            end if;
1068                         end;
1069                      end loop;
1070                   end if;
1071                end;
1072             end if;
1073
1074             --  Now that all the arguments are set, compile the binder
1075             --  generated file.
1076
1077             Display (Gcc);
1078             GNAT.OS_Lib.Spawn
1079               (Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
1080
1081             if not Success then
1082                Com.Fail
1083                  ("could not compile binder generated file for library ",
1084                   Get_Name_String (Data.Library_Name));
1085             end if;
1086
1087             --  Process binder generated file for pragmas Linker_Options
1088
1089             Process_Binder_File (Arguments (2).all & ASCII.NUL);
1090          end if;
1091       end if;
1092
1093       --  Build the library only if Link is True
1094
1095       if Link then
1096          --  If attribute Library_GCC was specified, get the driver name
1097
1098          Library_GCC := Value_Of (Name_Library_GCC, Data.Decl.Attributes);
1099
1100          if not Library_GCC.Default then
1101             Driver_Name := Library_GCC.Value;
1102          end if;
1103
1104          --  If attribute Library_Options was specified, add these additional
1105          --  options.
1106
1107          Library_Options :=
1108            Value_Of (Name_Library_Options, Data.Decl.Attributes);
1109
1110          if not Library_Options.Default then
1111             declare
1112                Current : String_List_Id := Library_Options.Values;
1113                Element : String_Element;
1114
1115             begin
1116                while Current /= Nil_String loop
1117                   Element := String_Elements.Table (Current);
1118                   Get_Name_String (Element.Value);
1119
1120                   if Name_Len /= 0 then
1121                      Opts.Increment_Last;
1122                      Opts.Table (Opts.Last) :=
1123                        new String'(Name_Buffer (1 .. Name_Len));
1124                   end if;
1125
1126                   Current := Element.Next;
1127                end loop;
1128             end;
1129          end if;
1130
1131          Lib_Dirpath  := new String'(Get_Name_String (Data.Library_Dir));
1132          Lib_Filename := new String'(Get_Name_String (Data.Library_Name));
1133
1134          case Data.Library_Kind is
1135             when Static =>
1136                The_Build_Mode := Static;
1137
1138             when Dynamic =>
1139                The_Build_Mode := Dynamic;
1140
1141             when Relocatable =>
1142                The_Build_Mode := Relocatable;
1143
1144                if PIC_Option /= "" then
1145                   Opts.Increment_Last;
1146                   Opts.Table (Opts.Last) := new String'(PIC_Option);
1147                end if;
1148          end case;
1149
1150          --  Get the library version, if any
1151
1152          if Data.Lib_Internal_Name /= No_Name then
1153             Lib_Version :=
1154               new String'(Get_Name_String (Data.Lib_Internal_Name));
1155          end if;
1156
1157          --  Add the objects found in the object directory and the object
1158          --  directories of the extended files, if any, except for generated
1159          --  object files (b~.. or B$..) from extended projects.
1160          --  When there are one or more extended files, only add an object file
1161          --  if no object file with the same name have already been added.
1162
1163          In_Main_Object_Directory := True;
1164
1165          loop
1166             declare
1167                Object_Dir_Path : constant String :=
1168                                    Get_Name_String (Data.Object_Directory);
1169                Object_Dir      : Dir_Type;
1170                Filename        : String (1 .. 255);
1171                Last            : Natural;
1172                Id              : Name_Id;
1173
1174             begin
1175                Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path);
1176
1177                --  For all entries in the object directory
1178
1179                loop
1180                   Read (Object_Dir, Filename, Last);
1181
1182                   exit when Last = 0;
1183
1184                   --  Check if it is an object file
1185
1186                   if Is_Obj (Filename (1 .. Last)) then
1187                      declare
1188                         Object_Path : String :=
1189                           Normalize_Pathname
1190                             (Object_Dir_Path & Directory_Separator &
1191                              Filename (1 .. Last));
1192
1193                      begin
1194                         Canonical_Case_File_Name (Object_Path);
1195                         Canonical_Case_File_Name (Filename (1 .. Last));
1196
1197                         --  If in the object directory of an extended project,
1198                         --  do not consider generated object files.
1199
1200                         if In_Main_Object_Directory
1201                           or else Last < 5
1202                           or else Filename (1 .. B_Start'Length) /= B_Start
1203                         then
1204                            Name_Len := Last;
1205                            Name_Buffer (1 .. Name_Len) := Filename (1 .. Last);
1206                            Id := Name_Find;
1207
1208                            if not Objects_Htable.Get (Id) then
1209
1210                               --  Record this object file
1211
1212                               Objects_Htable.Set (Id, True);
1213                               Objects.Increment_Last;
1214                               Objects.Table (Objects.Last) :=
1215                                 new String'(Object_Path);
1216
1217                               declare
1218                                  ALI_File : constant String :=
1219                                               Ext_To (Object_Path, "ali");
1220
1221                               begin
1222                                  if Is_Regular_File (ALI_File) then
1223
1224                                     --  Record the ALI file
1225
1226                                     ALIs.Increment_Last;
1227                                     ALIs.Table (ALIs.Last) :=
1228                                       new String'(ALI_File);
1229
1230                                     --  Find out if for this ALI file,
1231                                     --  libgnarl or libdecgnat (on OpenVMS)
1232                                     --  is necessary.
1233
1234                                     Check_Libs (ALI_File);
1235
1236                                  else
1237                                     --  Object file is a foreign object file
1238
1239                                     Foreigns.Increment_Last;
1240                                     Foreigns.Table (Foreigns.Last) :=
1241                                       new String'(Object_Path);
1242                                  end if;
1243                               end;
1244                            end if;
1245                         end if;
1246                      end;
1247                   end if;
1248                end loop;
1249
1250                Close (Dir => Object_Dir);
1251
1252             exception
1253                when Directory_Error =>
1254                   Com.Fail ("cannot find object directory """,
1255                             Get_Name_String (Data.Object_Directory),
1256                             """");
1257             end;
1258
1259             exit when Data.Extends = No_Project;
1260
1261             In_Main_Object_Directory  := False;
1262             Data := Projects.Table (Data.Extends);
1263          end loop;
1264
1265          --  Add the -L and -l switches for the imported Library Project Files,
1266          --  and, if Path Option is supported, the library directory path names
1267          --  to Rpath.
1268
1269          Process_Imported_Libraries;
1270
1271          --  Link with libgnat and possibly libgnarl
1272
1273          Opts.Increment_Last;
1274          Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory);
1275
1276          --  If Path Option is supported, add libgnat directory path name to
1277          --  Rpath.
1278
1279          if Path_Option /= null then
1280             Add_Rpath (Lib_Directory);
1281          end if;
1282
1283          if Libgnarl_Needed then
1284             Opts.Increment_Last;
1285
1286             if The_Build_Mode = Static then
1287                Opts.Table (Opts.Last) := new String'("-lgnarl");
1288             else
1289                Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnarl"));
1290             end if;
1291          end if;
1292
1293          if Libdecgnat_Needed then
1294             Opts.Increment_Last;
1295             Opts.Table (Opts.Last) :=
1296               new String'("-L" & Lib_Directory & "/../declib");
1297             Opts.Increment_Last;
1298             Opts.Table (Opts.Last) := new String'("-ldecgnat");
1299          end if;
1300
1301          Opts.Increment_Last;
1302
1303          if The_Build_Mode = Static then
1304             Opts.Table (Opts.Last) := new String'("-lgnat");
1305          else
1306             Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnat"));
1307          end if;
1308
1309          --  If Path Option is supported, add the necessary switch with the
1310          --  content of Rpath. As Rpath contains at least libgnat directory
1311          --  path name, it is guaranteed that it is not null.
1312
1313          if Path_Option /= null then
1314             Opts.Increment_Last;
1315             Opts.Table (Opts.Last) :=
1316               new String'(Path_Option.all & Rpath (1 .. Rpath_Last));
1317             Free (Path_Option);
1318             Free (Rpath);
1319          end if;
1320
1321          Object_Files :=
1322            new Argument_List'
1323              (Argument_List (Objects.Table (1 .. Objects.Last)));
1324
1325          Foreign_Objects :=
1326            new Argument_List'(Argument_List
1327                                 (Foreigns.Table (1 .. Foreigns.Last)));
1328
1329          Ali_Files :=
1330            new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
1331
1332          Options :=
1333            new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
1334
1335          --  We fail if there are no object to put in the library
1336          --  (Ada or foreign objects).
1337
1338          if Object_Files'Length = 0 then
1339             Com.Fail ("no object files for library """ &
1340                       Lib_Filename.all & '"');
1341          end if;
1342
1343          if not Opt.Quiet_Output then
1344             Write_Eol;
1345             Write_Str  ("building ");
1346             Write_Str (Ada.Characters.Handling.To_Lower
1347                          (Build_Mode_State'Image (The_Build_Mode)));
1348             Write_Str  (" library for project ");
1349             Write_Line (Project_Name);
1350
1351             Write_Eol;
1352
1353             Write_Line ("object files:");
1354
1355             for Index in Object_Files'Range loop
1356                Write_Str  ("   ");
1357                Write_Line (Object_Files (Index).all);
1358             end loop;
1359
1360             Write_Eol;
1361
1362             if Ali_Files'Length = 0 then
1363                Write_Line ("NO ALI files");
1364
1365             else
1366                Write_Line ("ALI files:");
1367
1368                for Index in Ali_Files'Range loop
1369                   Write_Str  ("   ");
1370                   Write_Line (Ali_Files (Index).all);
1371                end loop;
1372             end if;
1373
1374             Write_Eol;
1375          end if;
1376
1377          --  We check that all object files are regular files
1378
1379          Check_Context;
1380
1381          --  Delete the existing library file, if it exists.
1382          --  Fail if the library file is not writable, or if it is not possible
1383          --  to delete the file.
1384
1385          declare
1386             DLL_Name : aliased String :=
1387                          Lib_Dirpath.all & "/lib" &
1388                            Lib_Filename.all & "." & DLL_Ext;
1389
1390             Archive_Name : aliased String :=
1391                              Lib_Dirpath.all & "/lib" &
1392                                Lib_Filename.all & "." & Archive_Ext;
1393
1394             type Str_Ptr is access all String;
1395             --  This type is necessary to meet the accessibility rules of Ada.
1396             --  It is not possible to use String_Access here.
1397
1398             Full_Lib_Name : Str_Ptr;
1399             --  Designates the full library path name. Either DLL_Name or
1400             --  Archive_Name, depending on the library kind.
1401
1402             Success : Boolean := False;
1403             --  Used to call Delete_File
1404
1405          begin
1406             if The_Build_Mode = Static then
1407                Full_Lib_Name := Archive_Name'Access;
1408             else
1409                Full_Lib_Name := DLL_Name'Access;
1410             end if;
1411
1412             if Is_Regular_File (Full_Lib_Name.all) then
1413                if Is_Writable_File (Full_Lib_Name.all) then
1414                   Delete_File (Full_Lib_Name.all, Success);
1415                end if;
1416
1417                if Is_Regular_File (Full_Lib_Name.all) then
1418                   Com.Fail ("could not delete """ & Full_Lib_Name.all & """");
1419                end if;
1420             end if;
1421          end;
1422
1423          Argument_Number := 0;
1424
1425          --  If we have a standalone library, gather all the interface ALI.
1426          --  They are passed to Build_Dynamic_Library, where they are used by
1427          --  some platforms (VMS, for example) to decide what symbols should be
1428          --  exported. They are also flagged as Interface when we copy them to
1429          --  the library directory (by Copy_ALI_Files, below).
1430
1431          if Standalone then
1432             Data := Projects.Table (For_Project);
1433
1434             declare
1435                Interface : String_List_Id := Data.Lib_Interface_ALIs;
1436                ALI       : File_Name_Type;
1437
1438             begin
1439                while Interface /= Nil_String loop
1440                   ALI := String_Elements.Table (Interface).Value;
1441                   Interface_ALIs.Set (ALI, True);
1442                   Get_Name_String (String_Elements.Table (Interface).Value);
1443                   Add_Argument (Name_Buffer (1 .. Name_Len));
1444                   Interface := String_Elements.Table (Interface).Next;
1445                end loop;
1446
1447                Interface := Data.Lib_Interface_ALIs;
1448
1449                if not Opt.Quiet_Output then
1450
1451                   --  Check that the interface set is complete: any unit in the
1452                   --  library that is needed by an interface should also be an
1453                   --  interface. If it is not the case, output a warning.
1454
1455                   while Interface /= Nil_String loop
1456                      ALI := String_Elements.Table (Interface).Value;
1457                      Process (ALI);
1458                      Interface := String_Elements.Table (Interface).Next;
1459                   end loop;
1460                end if;
1461             end;
1462          end if;
1463
1464          --  Clean the library directory, if it is also the directory where
1465          --  the ALI files are copied, either because there is no interface
1466          --  copy directory or because the interface copy directory is the
1467          --  same as the library directory.
1468
1469          Copy_Dir := Projects.Table (For_Project).Library_Dir;
1470          Clean (Copy_Dir);
1471
1472          --  Call procedure to build the library, depending on the build mode
1473
1474          case The_Build_Mode is
1475             when Dynamic | Relocatable =>
1476                Build_Dynamic_Library
1477                  (Ofiles        => Object_Files.all,
1478                   Foreign       => Foreign_Objects.all,
1479                   Afiles        => Ali_Files.all,
1480                   Options       => Options.all,
1481                   Interfaces    => Arguments (1 .. Argument_Number),
1482                   Lib_Filename  => Lib_Filename.all,
1483                   Lib_Dir       => Lib_Dirpath.all,
1484                   Symbol_Data   => Data.Symbol_Data,
1485                   Driver_Name   => Driver_Name,
1486                   Lib_Address   => DLL_Address.all,
1487                   Lib_Version   => Lib_Version.all,
1488                   Relocatable   => The_Build_Mode = Relocatable,
1489                   Auto_Init     => Data.Lib_Auto_Init);
1490
1491             when Static =>
1492                MLib.Build_Library
1493                  (Object_Files.all,
1494                   Ali_Files.all,
1495                   Lib_Filename.all,
1496                   Lib_Dirpath.all);
1497
1498             when None =>
1499                null;
1500          end case;
1501
1502          --  We need to copy the ALI files from the object directory to
1503          --  the library directory, so that the linker find them there,
1504          --  and does not need to look in the object directory where it
1505          --  would also find the object files; and we don't want that:
1506          --  we want the linker to use the library.
1507
1508          --  Copy the ALI files and make the copies read-only. For interfaces,
1509          --  mark the copies as interfaces.
1510
1511          Copy_ALI_Files
1512            (Files      => Ali_Files.all,
1513             To         => Copy_Dir,
1514             Interfaces => Arguments (1 .. Argument_Number));
1515
1516          --  Copy interface sources if Library_Src_Dir specified
1517
1518          if Standalone
1519            and then Projects.Table (For_Project).Library_Src_Dir /= No_Name
1520          then
1521             --  Clean the interface copy directory, if it is not also the
1522             --  library directory. If it is also the library directory, it
1523             --  has already been cleaned before generation of the library.
1524
1525             if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then
1526                Copy_Dir := Projects.Table (For_Project).Library_Src_Dir;
1527                Clean (Copy_Dir);
1528             end if;
1529
1530             Copy_Interface_Sources
1531               (For_Project => For_Project,
1532                Interfaces => Arguments (1 .. Argument_Number),
1533                To_Dir => Copy_Dir);
1534          end if;
1535       end if;
1536
1537       --  Reset the current working directory to its previous value
1538
1539       Change_Dir (Current_Dir);
1540    end Build_Library;
1541
1542    -----------
1543    -- Check --
1544    -----------
1545
1546    procedure Check (Filename : String) is
1547    begin
1548       if not Is_Regular_File (Filename) then
1549          Com.Fail (Filename, " not found.");
1550       end if;
1551    end Check;
1552
1553    -------------------
1554    -- Check_Context --
1555    -------------------
1556
1557    procedure Check_Context is
1558    begin
1559       --  Check that each object file exists
1560
1561       for F in Object_Files'Range loop
1562          Check (Object_Files (F).all);
1563       end loop;
1564    end Check_Context;
1565
1566    -------------------
1567    -- Check_Library --
1568    -------------------
1569
1570    procedure Check_Library (For_Project : Project_Id) is
1571       Data : constant Project_Data := Projects.Table (For_Project);
1572
1573    begin
1574       if Data.Library and not Data.Flag1 then
1575          declare
1576             Current  : constant Dir_Name_Str := Get_Current_Dir;
1577             Lib_Name : constant Name_Id := Library_File_Name_For (For_Project);
1578             Lib_TS   : Time_Stamp_Type;
1579             Obj_TS   : Time_Stamp_Type;
1580
1581             Object_Dir : Dir_Type;
1582
1583          begin
1584             if Hostparm.OpenVMS then
1585                B_Start (B_Start'Last) := '$';
1586             end if;
1587
1588             Change_Dir (Get_Name_String (Data.Library_Dir));
1589
1590             Lib_TS := File_Stamp (Lib_Name);
1591
1592             --  If the library file does not exist, then the time stamp will
1593             --  be Empty_Time_Stamp, earlier than any other time stamp.
1594
1595             Change_Dir (Get_Name_String (Data.Object_Directory));
1596             Open (Dir => Object_Dir, Dir_Name => ".");
1597
1598             --  For all entries in the object directory
1599
1600             loop
1601                Read (Object_Dir, Name_Buffer, Name_Len);
1602                exit when Name_Len = 0;
1603
1604                --  Check if it is an object file, but ignore any binder
1605                --  generated file.
1606
1607                if Is_Obj (Name_Buffer (1 .. Name_Len))
1608                   and then Name_Buffer (1 .. B_Start'Length) /= B_Start
1609                then
1610                   --  Get the object file time stamp
1611
1612                   Obj_TS := File_Stamp (Name_Find);
1613
1614                   --  If library file time stamp is earlier, set Flag1 and
1615                   --  return. String comparaison is used, otherwise time stamps
1616                   --  may be too close and the comparaison would return True,
1617                   --  which would trigger an unnecessary rebuild of the
1618                   --  library.
1619
1620                   if String (Lib_TS) < String (Obj_TS) then
1621
1622                      --  Library must be rebuilt
1623
1624                      Projects.Table (For_Project).Flag1 := True;
1625                      exit;
1626                   end if;
1627                end if;
1628             end loop;
1629
1630             Change_Dir (Current);
1631          end;
1632       end if;
1633    end Check_Library;
1634
1635    -----------
1636    -- Clean --
1637    -----------
1638
1639    procedure Clean (Directory : Name_Id) is
1640       Current  : constant Dir_Name_Str := Get_Current_Dir;
1641
1642       Dir : Dir_Type;
1643
1644       Name : String (1 .. 200);
1645       Last : Natural;
1646
1647       Disregard : Boolean;
1648
1649       procedure Set_Writable (Name : System.Address);
1650       pragma Import (C, Set_Writable, "__gnat_set_writable");
1651
1652    begin
1653       Get_Name_String (Directory);
1654
1655       --  Change the working directory to the directory to clean
1656
1657       begin
1658          Change_Dir (Name_Buffer (1 .. Name_Len));
1659
1660       exception
1661          when others =>
1662             Com.Fail
1663               ("unable to access directory """,
1664                Name_Buffer (1 .. Name_Len),
1665                """");
1666       end;
1667
1668       Open (Dir, ".");
1669
1670       --  For each regular file in the directory, make it writable and
1671       --  delete the file.
1672
1673       loop
1674          Read (Dir, Name, Last);
1675          exit when Last = 0;
1676
1677          if Is_Regular_File (Name (1 .. Last)) then
1678             Name (Last + 1) := ASCII.NUL;
1679             Set_Writable (Name (1)'Address);
1680             Delete_File (Name (1 .. Last), Disregard);
1681          end if;
1682       end loop;
1683
1684       Close (Dir);
1685
1686       --  Restore the initial working directory
1687
1688       Change_Dir (Current);
1689    end Clean;
1690
1691    ----------------------------
1692    -- Copy_Interface_Sources --
1693    ----------------------------
1694
1695    procedure Copy_Interface_Sources
1696      (For_Project : Project_Id;
1697       Interfaces  : Argument_List;
1698       To_Dir      : Name_Id)
1699    is
1700       Current  : constant Dir_Name_Str := Get_Current_Dir;
1701       Target   : constant Dir_Name_Str := Get_Name_String (To_Dir);
1702
1703       Text     : Text_Buffer_Ptr;
1704       The_ALI  : ALI.ALI_Id;
1705       Lib_File : Name_Id;
1706
1707       First_Unit  : ALI.Unit_Id;
1708       Second_Unit : ALI.Unit_Id;
1709
1710       Data : Unit_Data;
1711
1712       Copy_Subunits : Boolean := False;
1713
1714       procedure Copy (File_Name : Name_Id);
1715       --  Copy one source of the project to the target directory
1716
1717       ----------
1718       -- Copy --
1719       ----------
1720
1721       procedure Copy (File_Name : Name_Id) is
1722          Success : Boolean := False;
1723
1724       begin
1725          Unit_Loop :
1726          for Index in 1 .. Com.Units.Last loop
1727             Data := Com.Units.Table (Index);
1728
1729             for J in Data.File_Names'Range loop
1730                if Data.File_Names (J).Project = For_Project
1731                  and then Data.File_Names (J).Name = File_Name
1732                then
1733                   Copy_File
1734                     (Get_Name_String (Data.File_Names (J).Path),
1735                      Target,
1736                      Success,
1737                      Mode => Overwrite,
1738                      Preserve => Preserve);
1739                   exit Unit_Loop;
1740                end if;
1741             end loop;
1742          end loop Unit_Loop;
1743       end Copy;
1744
1745       use ALI;
1746
1747    --  Start of processing for Copy_Interface_Sources
1748
1749    begin
1750       --  Change the working directory to the object directory
1751
1752       Change_Dir
1753         (Get_Name_String (Projects.Table (For_Project).Object_Directory));
1754
1755       for Index in Interfaces'Range loop
1756
1757          --  First, load the ALI file
1758
1759          Name_Len := 0;
1760          Add_Str_To_Name_Buffer (Interfaces (Index).all);
1761          Lib_File := Name_Find;
1762          Text := Read_Library_Info (Lib_File);
1763          The_ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
1764          Free (Text);
1765
1766          Second_Unit := No_Unit_Id;
1767          First_Unit := ALI.ALIs.Table (The_ALI).First_Unit;
1768          Copy_Subunits := True;
1769
1770          --  If there is both a spec and a body, check if they are both needed
1771
1772          if ALI.Units.Table (First_Unit).Utype = Is_Body then
1773             Second_Unit := ALI.ALIs.Table (The_ALI).Last_Unit;
1774
1775             --  If the body is not needed, then reset First_Unit
1776
1777             if not ALI.Units.Table (Second_Unit).Body_Needed_For_SAL then
1778                First_Unit := No_Unit_Id;
1779                Copy_Subunits := False;
1780             end if;
1781
1782          elsif ALI.Units.Table (First_Unit).Utype = Is_Spec_Only then
1783             Copy_Subunits := False;
1784          end if;
1785
1786          --  Copy the file(s) that need to be copied
1787
1788          if First_Unit /= No_Unit_Id then
1789             Copy (File_Name => ALI.Units.Table (First_Unit).Sfile);
1790          end if;
1791
1792          if Second_Unit /= No_Unit_Id then
1793             Copy (File_Name => ALI.Units.Table (Second_Unit).Sfile);
1794          end if;
1795
1796          --  Copy all the separates, if any
1797
1798          if Copy_Subunits then
1799             for Dep in ALI.ALIs.Table (The_ALI).First_Sdep ..
1800               ALI.ALIs.Table (The_ALI).Last_Sdep
1801             loop
1802                if Sdep.Table (Dep).Subunit_Name /= No_Name then
1803                   Copy (File_Name => Sdep.Table (Dep).Sfile);
1804                end if;
1805             end loop;
1806          end if;
1807       end loop;
1808
1809       --  Restore the initial working directory
1810
1811       Change_Dir (Current);
1812    end Copy_Interface_Sources;
1813
1814    -------------
1815    -- Display --
1816    -------------
1817
1818    procedure Display (Executable : String) is
1819    begin
1820       if not Opt.Quiet_Output then
1821          Write_Str (Executable);
1822
1823          for Index in 1 .. Argument_Number loop
1824             Write_Char (' ');
1825             Write_Str (Arguments (Index).all);
1826          end loop;
1827
1828          Write_Eol;
1829       end if;
1830    end Display;
1831
1832    -------------------------
1833    -- Process_Binder_File --
1834    -------------------------
1835
1836    procedure Process_Binder_File (Name : String) is
1837       Fd : FILEs;
1838       --  Binder file's descriptor
1839
1840       Read_Mode  : constant String := "r" & ASCII.Nul;
1841       --  For fopen
1842
1843       Status : Interfaces.C_Streams.int;
1844       pragma Unreferenced (Status);
1845       --  For fclose
1846
1847       Begin_Info : constant String := "--  BEGIN Object file/option list";
1848       End_Info   : constant String := "--  END Object file/option list   ";
1849
1850       Next_Line : String (1 .. 1000);
1851       --  Current line value
1852       --  Where does this odd constant 1000 come from, looks suspicious ???
1853
1854       Nlast : Integer;
1855       --  End of line slice (the slice does not contain the line terminator)
1856
1857       procedure Get_Next_Line;
1858       --  Read the next line from the binder file without the line terminator
1859
1860       -------------------
1861       -- Get_Next_Line --
1862       -------------------
1863
1864       procedure Get_Next_Line is
1865          Fchars : chars;
1866
1867       begin
1868          Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
1869
1870          if Fchars = System.Null_Address then
1871             Fail ("Error reading binder output");
1872          end if;
1873
1874          Nlast := 1;
1875          while Nlast <= Next_Line'Last
1876            and then Next_Line (Nlast) /= ASCII.LF
1877            and then Next_Line (Nlast) /= ASCII.CR
1878          loop
1879             Nlast := Nlast + 1;
1880          end loop;
1881
1882          Nlast := Nlast - 1;
1883       end Get_Next_Line;
1884
1885    --  Start of processing for Process_Binder_File
1886
1887    begin
1888       Fd := fopen (Name'Address, Read_Mode'Address);
1889
1890       if Fd = NULL_Stream then
1891          Fail ("Failed to open binder output");
1892       end if;
1893
1894       --  Skip up to the Begin Info line
1895
1896       loop
1897          Get_Next_Line;
1898          exit when Next_Line (1 .. Nlast) = Begin_Info;
1899       end loop;
1900
1901       --  Find the first switch
1902
1903       loop
1904          Get_Next_Line;
1905
1906          exit when Next_Line (1 .. Nlast) = End_Info;
1907
1908          --  As the binder generated file is in Ada, remove the first eight
1909          --  characters "   --   ".
1910
1911          Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
1912          Nlast := Nlast - 8;
1913
1914          --  Stop when the first switch is found
1915
1916          exit when Next_Line (1) = '-';
1917       end loop;
1918
1919       if Next_Line (1 .. Nlast) /= End_Info then
1920          loop
1921             --  Ignore -static and -shared, since -shared will be used
1922             --  in any case.
1923
1924             --  Ignore -lgnat, -lgnarl and -ldecgnat as they will be added
1925             --  later, because they are also needed for non Stand-Alone shared
1926             --  libraries.
1927
1928             --  Also ignore the shared libraries which are :
1929
1930             --  UNIX / Windows    VMS
1931             --  -lgnat-<version>  -lgnat_<version>  (7 + version'length chars)
1932             --  -lgnarl-<version> -lgnarl_<version> (8 + version'length chars)
1933
1934             if Next_Line (1 .. Nlast) /= "-static" and then
1935                Next_Line (1 .. Nlast) /= "-shared" and then
1936                Next_Line (1 .. Nlast) /= "-ldecgnat" and then
1937                Next_Line (1 .. Nlast) /= "-lgnarl" and then
1938                Next_Line (1 .. Nlast) /= "-lgnat" and then
1939                Next_Line
1940                  (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
1941                    Shared_Lib ("gnarl") and then
1942                Next_Line
1943                  (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /=
1944                    Shared_Lib ("gnat")
1945             then
1946                if Next_Line (1) /= '-' then
1947
1948                   --  This is not an option, should we add it?
1949
1950                   if Add_Object_Files then
1951                      Opts.Increment_Last;
1952                      Opts.Table (Opts.Last) :=
1953                        new String'(Next_Line (1 .. Nlast));
1954                   end if;
1955
1956                else
1957                   --  Add all other options
1958
1959                   Opts.Increment_Last;
1960                   Opts.Table (Opts.Last) :=
1961                     new String'(Next_Line (1 .. Nlast));
1962                end if;
1963             end if;
1964
1965             --  Next option, if any
1966
1967             Get_Next_Line;
1968             exit when Next_Line (1 .. Nlast) = End_Info;
1969
1970             --  Remove first eight characters "   --   "
1971
1972             Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
1973             Nlast := Nlast - 8;
1974          end loop;
1975       end if;
1976
1977       Status := fclose (Fd);
1978       --  Is it really right to ignore any close error ???
1979    end Process_Binder_File;
1980
1981    ------------------
1982    -- Reset_Tables --
1983    ------------------
1984
1985    procedure Reset_Tables is
1986    begin
1987       Objects.Init;
1988       Objects_Htable.Reset;
1989       Foreigns.Init;
1990       ALIs.Init;
1991       Opts.Init;
1992       Processed_Projects.Reset;
1993       Library_Projs.Init;
1994    end Reset_Tables;
1995
1996 end MLib.Prj;