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