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