aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/ada/mlib-prj.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/ada/mlib-prj.adb')
-rw-r--r--gcc-4.9/gcc/ada/mlib-prj.adb2528
1 files changed, 2528 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/ada/mlib-prj.adb b/gcc-4.9/gcc/ada/mlib-prj.adb
new file mode 100644
index 000000000..945f91372
--- /dev/null
+++ b/gcc-4.9/gcc/ada/mlib-prj.adb
@@ -0,0 +1,2528 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- M L I B . P R J --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2001-2013, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with ALI; use ALI;
+with Gnatvsn; use Gnatvsn;
+with Makeutl; use Makeutl;
+with MLib.Fil; use MLib.Fil;
+with MLib.Tgt; use MLib.Tgt;
+with MLib.Utl; use MLib.Utl;
+with Opt;
+with Output; use Output;
+with Prj.Com; use Prj.Com;
+with Prj.Env; use Prj.Env;
+with Prj.Util; use Prj.Util;
+with Sinput.P;
+with Snames; use Snames;
+with Switch; use Switch;
+with Table;
+with Targparm; use Targparm;
+with Tempdir;
+with Types; use Types;
+
+with Ada.Characters.Handling;
+
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.HTable;
+with Interfaces.C_Streams; use Interfaces.C_Streams;
+with System; use System;
+with System.Case_Util; use System.Case_Util;
+
+package body MLib.Prj is
+
+ Prj_Add_Obj_Files : Types.Int;
+ pragma Import (C, Prj_Add_Obj_Files, "__gnat_prj_add_obj_files");
+ Add_Object_Files : constant Boolean := Prj_Add_Obj_Files /= 0;
+ -- Indicates if object files in pragmas Linker_Options (found in the
+ -- binder generated file) should be taken when linking a stand-alone
+ -- library. False for Windows, True for other platforms.
+
+ ALI_Suffix : constant String := ".ali";
+
+ B_Start : String_Ptr := new String'("b~");
+ -- Prefix of bind file, changed to b__ for VMS
+
+ S_Osinte_Ads : File_Name_Type := No_File;
+ -- Name_Id for "s-osinte.ads"
+
+ S_Dec_Ads : File_Name_Type := No_File;
+ -- Name_Id for "dec.ads"
+
+ Arguments : String_List_Access := No_Argument;
+ -- Used to accumulate arguments for the invocation of gnatbind and of the
+ -- compiler. Also used to collect the interface ALI when copying the ALI
+ -- files to the library directory.
+
+ Argument_Number : Natural := 0;
+ -- Index of the last argument in Arguments
+
+ Initial_Argument_Max : constant := 10;
+ -- Where does the magic constant 10 come from???
+
+ No_Main_String : aliased String := "-n";
+ No_Main : constant String_Access := No_Main_String'Access;
+
+ Output_Switch_String : aliased String := "-o";
+ Output_Switch : constant String_Access :=
+ Output_Switch_String'Access;
+
+ Compile_Switch_String : aliased String := "-c";
+ Compile_Switch : constant String_Access :=
+ Compile_Switch_String'Access;
+
+ No_Warning_String : aliased String := "-gnatws";
+ No_Warning : constant String_Access := No_Warning_String'Access;
+
+ Auto_Initialize : constant String := "-a";
+
+ -- List of objects to put inside the library
+
+ Object_Files : Argument_List_Access;
+
+ package Objects is new Table.Table
+ (Table_Name => "Mlib.Prj.Objects",
+ Table_Component_Type => String_Access,
+ Table_Index_Type => Natural,
+ Table_Low_Bound => 1,
+ Table_Initial => 50,
+ Table_Increment => 100);
+
+ package Objects_Htable is new GNAT.HTable.Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Boolean,
+ No_Element => False,
+ Key => Name_Id,
+ Hash => Hash,
+ Equal => "=");
+
+ -- List of ALI files
+
+ Ali_Files : Argument_List_Access;
+
+ package ALIs is new Table.Table
+ (Table_Name => "Mlib.Prj.Alis",
+ Table_Component_Type => String_Access,
+ Table_Index_Type => Natural,
+ Table_Low_Bound => 1,
+ Table_Initial => 50,
+ Table_Increment => 100);
+
+ -- List of options set in the command line
+
+ Options : Argument_List_Access;
+
+ package Opts is new Table.Table
+ (Table_Name => "Mlib.Prj.Opts",
+ Table_Component_Type => String_Access,
+ Table_Index_Type => Natural,
+ Table_Low_Bound => 1,
+ Table_Initial => 5,
+ Table_Increment => 100);
+
+ -- All the ALI file in the library
+
+ package Library_ALIs is new GNAT.HTable.Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Boolean,
+ No_Element => False,
+ Key => File_Name_Type,
+ Hash => Hash,
+ Equal => "=");
+
+ -- The ALI files in the interface sets
+
+ package Interface_ALIs is new GNAT.HTable.Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Boolean,
+ No_Element => False,
+ Key => File_Name_Type,
+ Hash => Hash,
+ Equal => "=");
+
+ -- The ALI files that have been processed to check if the corresponding
+ -- library unit is in the interface set.
+
+ package Processed_ALIs is new GNAT.HTable.Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Boolean,
+ No_Element => False,
+ Key => File_Name_Type,
+ Hash => Hash,
+ Equal => "=");
+
+ -- The projects imported directly or indirectly
+
+ package Processed_Projects is new GNAT.HTable.Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Boolean,
+ No_Element => False,
+ Key => Name_Id,
+ Hash => Hash,
+ Equal => "=");
+
+ -- The library projects imported directly or indirectly
+
+ package Library_Projs is new Table.Table (
+ Table_Component_Type => Project_Id,
+ Table_Index_Type => Integer,
+ Table_Low_Bound => 1,
+ Table_Initial => 10,
+ Table_Increment => 10,
+ Table_Name => "Make.Library_Projs");
+
+ type Build_Mode_State is (None, Static, Dynamic, Relocatable);
+
+ procedure Add_Argument (S : String);
+ -- Add one argument to Arguments array, if array is full, double its size
+
+ function ALI_File_Name (Source : String) return String;
+ -- Return the ALI file name corresponding to a source
+
+ procedure Check (Filename : String);
+ -- Check if filename is a regular file. Fail if it is not
+
+ procedure Check_Context;
+ -- Check each object files in table Object_Files
+ -- Fail if any of them is not a regular file
+
+ procedure Copy_Interface_Sources
+ (For_Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Interfaces : Argument_List;
+ To_Dir : Path_Name_Type);
+ -- Copy the interface sources of a SAL to directory To_Dir
+
+ procedure Display (Executable : String);
+ -- Display invocation of gnatbind and of the compiler with the arguments
+ -- in Arguments, except when Quiet_Output is True.
+
+ function Index (S, Pattern : String) return Natural;
+ -- Return the last occurrence of Pattern in S, or 0 if none
+
+ procedure Process_Binder_File (Name : String);
+ -- For Stand-Alone libraries, get the Linker Options in the binder
+ -- generated file.
+
+ procedure Reset_Tables;
+ -- Make sure that all the above tables are empty
+ -- (Objects, Ali_Files, Options).
+
+ function SALs_Use_Constructors return Boolean;
+ -- Indicate if Stand-Alone Libraries are automatically initialized using
+ -- the constructor mechanism.
+
+ ------------------
+ -- Add_Argument --
+ ------------------
+
+ procedure Add_Argument (S : String) is
+ begin
+ if Argument_Number = Arguments'Last then
+ declare
+ New_Args : constant String_List_Access :=
+ new String_List (1 .. 2 * Arguments'Last);
+
+ begin
+ -- Copy the String_Accesses and set them to null in Arguments
+ -- so that they will not be deallocated by the call to
+ -- Free (Arguments).
+
+ New_Args (Arguments'Range) := Arguments.all;
+ Arguments.all := (others => null);
+ Free (Arguments);
+ Arguments := New_Args;
+ end;
+ end if;
+
+ Argument_Number := Argument_Number + 1;
+ Arguments (Argument_Number) := new String'(S);
+ end Add_Argument;
+
+ -------------------
+ -- ALI_File_Name --
+ -------------------
+
+ function ALI_File_Name (Source : String) return String is
+ begin
+ -- If the source name has an extension, then replace it with
+ -- the ALI suffix.
+
+ for Index in reverse Source'First + 1 .. Source'Last loop
+ if Source (Index) = '.' then
+ return Source (Source'First .. Index - 1) & ALI_Suffix;
+ end if;
+ end loop;
+
+ -- If there is no dot, or if it is the first character, just add the
+ -- ALI suffix.
+
+ return Source & ALI_Suffix;
+ end ALI_File_Name;
+
+ -------------------
+ -- Build_Library --
+ -------------------
+
+ procedure Build_Library
+ (For_Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Gnatbind : String;
+ Gnatbind_Path : String_Access;
+ Gcc : String;
+ Gcc_Path : String_Access;
+ Bind : Boolean := True;
+ Link : Boolean := True)
+ is
+ Maximum_Size : Integer;
+ pragma Import (C, Maximum_Size, "__gnat_link_max");
+ -- Maximum number of bytes to put in an invocation of gnatbind
+
+ Size : Integer;
+ -- The number of bytes for the invocation of gnatbind
+
+ Warning_For_Library : Boolean := False;
+ -- Set True for first warning for a unit missing from the interface set
+
+ Current_Proj : Project_Id;
+
+ Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed;
+ -- Set True if library needs to be linked with libgnarl
+
+ Libdecgnat_Needed : Boolean := False;
+ -- On OpenVMS, set True if library needs to be linked with libdecgnat
+
+ Object_Directory_Path : constant String :=
+ Get_Name_String
+ (For_Project.Object_Directory.Display_Name);
+
+ Standalone : constant Boolean := For_Project.Standalone_Library /= No;
+
+ Project_Name : constant String := Get_Name_String (For_Project.Name);
+
+ Current_Dir : constant String := Get_Current_Dir;
+
+ Lib_Filename : String_Access;
+ Lib_Dirpath : String_Access;
+ Lib_Version : String_Access := new String'("");
+
+ The_Build_Mode : Build_Mode_State := None;
+
+ Success : Boolean := False;
+
+ Library_Options : Variable_Value := Nil_Variable_Value;
+
+ Driver_Name : Name_Id := No_Name;
+
+ In_Main_Object_Directory : Boolean := True;
+
+ Foreign_Sources : Boolean;
+
+ Rpath : String_Access := null;
+ -- Allocated only if Path Option is supported
+
+ Rpath_Last : Natural := 0;
+ -- Index of last valid character of Rpath
+
+ Initial_Rpath_Length : constant := 200;
+ -- Initial size of Rpath, when first allocated
+
+ Path_Option : String_Access := Linker_Library_Path_Option;
+ -- If null, Path Option is not supported. Not a constant so that it can
+ -- be deallocated.
+
+ First_ALI : File_Name_Type := No_File;
+ -- Store the ALI file name of a source of the library (the first found)
+
+ procedure Add_ALI_For (Source : File_Name_Type);
+ -- Add name of the ALI file corresponding to Source to the Arguments
+
+ procedure Add_Rpath (Path : String);
+ -- Add a path name to Rpath
+
+ function Check_Project (P : Project_Id) return Boolean;
+ -- Returns True if P is For_Project or a project extended by For_Project
+
+ procedure Check_Libs (ALI_File : String; Main_Project : Boolean);
+ -- Set Libgnarl_Needed if the ALI_File indicates that there is a need
+ -- to link with -lgnarl (this is the case when there is a dependency
+ -- on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
+ -- indicates that there is a need to link with -ldecgnat (this is the
+ -- case when there is a dependency on dec.ads).
+
+ procedure Process (The_ALI : File_Name_Type);
+ -- Check if the closure of a library unit which is or should be in the
+ -- interface set is also in the interface set. Issue a warning for each
+ -- missing library unit.
+
+ procedure Process_Imported_Libraries;
+ -- Add the -L and -l switches for the imported Library Project Files,
+ -- and, if Path Option is supported, the library directory path names
+ -- to Rpath.
+
+ -----------------
+ -- Add_ALI_For --
+ -----------------
+
+ procedure Add_ALI_For (Source : File_Name_Type) is
+ ALI : constant String := ALI_File_Name (Get_Name_String (Source));
+ ALI_Id : File_Name_Type;
+
+ begin
+ if Bind then
+ Add_Argument (ALI);
+ end if;
+
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (S => ALI);
+ ALI_Id := Name_Find;
+
+ -- Add the ALI file name to the library ALIs
+
+ if Bind then
+ Library_ALIs.Set (ALI_Id, True);
+ end if;
+
+ -- Set First_ALI, if not already done
+
+ if First_ALI = No_File then
+ First_ALI := ALI_Id;
+ end if;
+ end Add_ALI_For;
+
+ ---------------
+ -- Add_Rpath --
+ ---------------
+
+ procedure Add_Rpath (Path : String) is
+
+ procedure Double;
+ -- Double Rpath size
+
+ ------------
+ -- Double --
+ ------------
+
+ procedure Double is
+ New_Rpath : constant String_Access :=
+ new String (1 .. 2 * Rpath'Length);
+ begin
+ New_Rpath (1 .. Rpath_Last) := Rpath (1 .. Rpath_Last);
+ Free (Rpath);
+ Rpath := New_Rpath;
+ end Double;
+
+ -- Start of processing for Add_Rpath
+
+ begin
+ -- If first path, allocate initial Rpath
+
+ if Rpath = null then
+ Rpath := new String (1 .. Initial_Rpath_Length);
+ Rpath_Last := 0;
+
+ else
+ -- Otherwise, add a path separator between two path names
+
+ if Rpath_Last = Rpath'Last then
+ Double;
+ end if;
+
+ Rpath_Last := Rpath_Last + 1;
+ Rpath (Rpath_Last) := Path_Separator;
+ end if;
+
+ -- Increase Rpath size until it is large enough
+
+ while Rpath_Last + Path'Length > Rpath'Last loop
+ Double;
+ end loop;
+
+ -- Add the path name
+
+ Rpath (Rpath_Last + 1 .. Rpath_Last + Path'Length) := Path;
+ Rpath_Last := Rpath_Last + Path'Length;
+ end Add_Rpath;
+
+ -------------------
+ -- Check_Project --
+ -------------------
+
+ function Check_Project (P : Project_Id) return Boolean is
+ begin
+ if P = For_Project then
+ return True;
+
+ elsif P /= No_Project then
+ declare
+ Proj : Project_Id;
+
+ begin
+ Proj := For_Project;
+ while Proj.Extends /= No_Project loop
+ if P = Proj.Extends then
+ return True;
+ end if;
+
+ Proj := Proj.Extends;
+ end loop;
+ end;
+ end if;
+
+ return False;
+ end Check_Project;
+
+ ----------------
+ -- Check_Libs --
+ ----------------
+
+ procedure Check_Libs (ALI_File : String; Main_Project : Boolean) is
+ Lib_File : File_Name_Type;
+ Text : Text_Buffer_Ptr;
+ Id : ALI.ALI_Id;
+
+ begin
+ if Libgnarl_Needed /= Yes
+ or else
+ (Main_Project
+ and then OpenVMS_On_Target)
+ then
+ -- Scan the ALI file
+
+ Name_Len := ALI_File'Length;
+ Name_Buffer (1 .. Name_Len) := ALI_File;
+ Lib_File := Name_Find;
+ Text := Read_Library_Info (Lib_File, True);
+
+ Id := ALI.Scan_ALI
+ (F => Lib_File,
+ T => Text,
+ Ignore_ED => False,
+ Err => True,
+ Read_Lines => "D");
+ Free (Text);
+
+ -- Look for s-osinte.ads in the dependencies
+
+ for Index in ALI.ALIs.Table (Id).First_Sdep ..
+ ALI.ALIs.Table (Id).Last_Sdep
+ loop
+ if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
+ Libgnarl_Needed := Yes;
+
+ if Main_Project then
+ For_Project.Libgnarl_Needed := Yes;
+ else
+ exit;
+ end if;
+
+ elsif OpenVMS_On_Target then
+ if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then
+ Libdecgnat_Needed := True;
+ end if;
+ end if;
+ end loop;
+ end if;
+ end Check_Libs;
+
+ -------------
+ -- Process --
+ -------------
+
+ procedure Process (The_ALI : File_Name_Type) is
+ Text : Text_Buffer_Ptr;
+ Idread : ALI_Id;
+ First_Unit : ALI.Unit_Id;
+ Last_Unit : ALI.Unit_Id;
+ Unit_Data : Unit_Record;
+ Afile : File_Name_Type;
+
+ begin
+ -- Nothing to do if the ALI file has already been processed.
+ -- This happens if an interface imports another interface.
+
+ if not Processed_ALIs.Get (The_ALI) then
+ Processed_ALIs.Set (The_ALI, True);
+ Text := Read_Library_Info (The_ALI);
+
+ if Text /= null then
+ Idread :=
+ Scan_ALI
+ (F => The_ALI,
+ T => Text,
+ Ignore_ED => False,
+ Err => True);
+ Free (Text);
+
+ if Idread /= No_ALI_Id then
+ First_Unit := ALI.ALIs.Table (Idread).First_Unit;
+ Last_Unit := ALI.ALIs.Table (Idread).Last_Unit;
+
+ -- Process both unit (spec and body) if the body is needed
+ -- by the spec (inline or generic). Otherwise, just process
+ -- the spec.
+
+ if First_Unit /= Last_Unit and then
+ not ALI.Units.Table (Last_Unit).Body_Needed_For_SAL
+ then
+ First_Unit := Last_Unit;
+ end if;
+
+ for Unit in First_Unit .. Last_Unit loop
+ Unit_Data := ALI.Units.Table (Unit);
+
+ -- Check if each withed unit which is in the library is
+ -- also in the interface set, if it has not yet been
+ -- processed.
+
+ for W in Unit_Data.First_With .. Unit_Data.Last_With loop
+ Afile := Withs.Table (W).Afile;
+
+ if Afile /= No_File and then Library_ALIs.Get (Afile)
+ and then not Processed_ALIs.Get (Afile)
+ then
+ if not Interface_ALIs.Get (Afile) then
+ if not Warning_For_Library then
+ Write_Str ("Warning: In library project """);
+ Get_Name_String (Current_Proj.Name);
+ To_Mixed (Name_Buffer (1 .. Name_Len));
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Line ("""");
+ Warning_For_Library := True;
+ end if;
+
+ Write_Str (" Unit """);
+ Get_Name_String (Withs.Table (W).Uname);
+ To_Mixed (Name_Buffer (1 .. Name_Len - 2));
+ Write_Str (Name_Buffer (1 .. Name_Len - 2));
+ Write_Line (""" is not in the interface set");
+ Write_Str (" but it is needed by ");
+
+ case Unit_Data.Utype is
+ when Is_Spec =>
+ Write_Str ("the spec of ");
+
+ when Is_Body =>
+ Write_Str ("the body of ");
+
+ when others =>
+ null;
+ end case;
+
+ Write_Str ("""");
+ Get_Name_String (Unit_Data.Uname);
+ To_Mixed (Name_Buffer (1 .. Name_Len - 2));
+ Write_Str (Name_Buffer (1 .. Name_Len - 2));
+ Write_Line ("""");
+ end if;
+
+ -- Now, process this unit
+
+ Process (Afile);
+ end if;
+ end loop;
+ end loop;
+ end if;
+ end if;
+ end if;
+ end Process;
+
+ --------------------------------
+ -- Process_Imported_Libraries --
+ --------------------------------
+
+ procedure Process_Imported_Libraries is
+ Current : Project_Id;
+
+ procedure Process_Project (Project : Project_Id);
+ -- Process Project and its imported projects recursively.
+ -- Add any library projects to table Library_Projs.
+
+ ---------------------
+ -- Process_Project --
+ ---------------------
+
+ procedure Process_Project (Project : Project_Id) is
+ Imported : Project_List;
+
+ begin
+ -- Nothing to do if process has already been processed
+
+ if not Processed_Projects.Get (Project.Name) then
+ Processed_Projects.Set (Project.Name, True);
+
+ -- Call Process_Project recursively for any imported project.
+ -- We first process the imported projects to guarantee that
+ -- we have a proper reverse order for the libraries.
+
+ Imported := Project.Imported_Projects;
+ while Imported /= null loop
+ if Imported.Project /= No_Project then
+ Process_Project (Imported.Project);
+ end if;
+
+ Imported := Imported.Next;
+ end loop;
+
+ -- If it is a library project, add it to Library_Projs
+
+ if Project /= For_Project and then Project.Library then
+ Library_Projs.Increment_Last;
+ Library_Projs.Table (Library_Projs.Last) := Project;
+
+ -- Check if because of this library we need to use libgnarl
+
+ if Libgnarl_Needed = Unknown then
+ if Project.Libgnarl_Needed = Unknown
+ and then Project.Object_Directory /= No_Path_Information
+ then
+ -- Check if libgnarl is needed for this library
+
+ declare
+ Object_Dir_Path : constant String :=
+ Get_Name_String
+ (Project.Object_Directory.
+ Display_Name);
+ Object_Dir : Dir_Type;
+ Filename : String (1 .. 255);
+ Last : Natural;
+
+ begin
+ Open (Object_Dir, Object_Dir_Path);
+
+ -- For all entries in the object directory
+
+ loop
+ Read (Object_Dir, Filename, Last);
+ exit when Last = 0;
+
+ -- Check if it is an object file
+
+ if Is_Obj (Filename (1 .. Last)) then
+ declare
+ Object_Path : constant String :=
+ Normalize_Pathname
+ (Object_Dir_Path &
+ Directory_Separator &
+ Filename (1 .. Last));
+ ALI_File : constant String :=
+ Ext_To
+ (Object_Path, "ali");
+
+ begin
+ if Is_Regular_File (ALI_File) then
+
+ -- Find out if for this ALI file,
+ -- libgnarl is necessary.
+
+ Check_Libs
+ (ALI_File, Main_Project => False);
+
+ if Libgnarl_Needed = Yes then
+ Project.Libgnarl_Needed := Yes;
+ For_Project.Libgnarl_Needed := Yes;
+ exit;
+ end if;
+ end if;
+ end;
+ end if;
+ end loop;
+
+ Close (Object_Dir);
+ end;
+ end if;
+
+ if Project.Libgnarl_Needed = Yes then
+ Libgnarl_Needed := Yes;
+ For_Project.Libgnarl_Needed := Yes;
+ end if;
+ end if;
+ end if;
+ end if;
+ end Process_Project;
+
+ -- Start of processing for Process_Imported_Libraries
+
+ begin
+ -- Build list of library projects imported directly or indirectly,
+ -- in the reverse order.
+
+ Process_Project (For_Project);
+
+ -- Add the -L and -l switches and, if the Rpath option is supported,
+ -- add the directory to the Rpath. As the library projects are in the
+ -- wrong order, process from the last to the first.
+
+ for Index in reverse 1 .. Library_Projs.Last loop
+ Current := Library_Projs.Table (Index);
+
+ Get_Name_String (Current.Library_Dir.Display_Name);
+ Opts.Increment_Last;
+ Opts.Table (Opts.Last) :=
+ new String'("-L" & Name_Buffer (1 .. Name_Len));
+
+ if Path_Option /= null then
+ Add_Rpath (Name_Buffer (1 .. Name_Len));
+ end if;
+
+ Opts.Increment_Last;
+ Opts.Table (Opts.Last) :=
+ new String'("-l" & Get_Name_String (Current.Library_Name));
+ end loop;
+ end Process_Imported_Libraries;
+
+ Path_FD : File_Descriptor := Invalid_FD;
+ -- Used for setting the source and object paths
+
+ -- Start of processing for Build_Library
+
+ begin
+ Reset_Tables;
+
+ -- Fail if project is not a library project
+
+ if not For_Project.Library then
+ Com.Fail ("project """ & Project_Name & """ has no library");
+ end if;
+
+ -- Do not attempt to build the library if it is externally built
+
+ if For_Project.Externally_Built then
+ return;
+ end if;
+
+ -- If this is the first time Build_Library is called, get the Name_Id
+ -- of "s-osinte.ads".
+
+ if S_Osinte_Ads = No_File then
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer ("s-osinte.ads");
+ S_Osinte_Ads := Name_Find;
+ end if;
+
+ if S_Dec_Ads = No_File then
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer ("dec.ads");
+ S_Dec_Ads := Name_Find;
+ end if;
+
+ -- We work in the object directory
+
+ Change_Dir (Object_Directory_Path);
+
+ if Standalone then
+
+ -- Call gnatbind only if Bind is True
+
+ if Bind then
+ if Gnatbind_Path = null then
+ Com.Fail ("unable to locate " & Gnatbind);
+ end if;
+
+ if Gcc_Path = null then
+ Com.Fail ("unable to locate " & Gcc);
+ end if;
+
+ -- Allocate Arguments, if it is the first time we see a standalone
+ -- library.
+
+ if Arguments = No_Argument then
+ Arguments := new String_List (1 .. Initial_Argument_Max);
+ end if;
+
+ -- Add "-n -o b~<lib>.adb (b__<lib>.adb on VMS) -L<lib>_"
+
+ Argument_Number := 2;
+ Arguments (1) := No_Main;
+ Arguments (2) := Output_Switch;
+
+ if OpenVMS_On_Target then
+ B_Start := new String'("b__");
+ end if;
+
+ Add_Argument
+ (B_Start.all
+ & Get_Name_String (For_Project.Library_Name) & ".adb");
+
+ -- Make sure that the init procedure is never "adainit"
+
+ Get_Name_String (For_Project.Library_Name);
+
+ if Name_Buffer (1 .. Name_Len) = "ada" then
+ Add_Argument ("-Lada_");
+ else
+ Add_Argument
+ ("-L" & Get_Name_String (For_Project.Library_Name));
+ end if;
+
+ if For_Project.Lib_Auto_Init and then SALs_Use_Constructors then
+ Add_Argument (Auto_Initialize);
+ end if;
+
+ -- Check if Binder'Default_Switches ("Ada") is defined. If it is,
+ -- add these switches to call gnatbind.
+
+ declare
+ Binder_Package : constant Package_Id :=
+ Value_Of
+ (Name => Name_Binder,
+ In_Packages => For_Project.Decl.Packages,
+ Shared => In_Tree.Shared);
+
+ begin
+ if Binder_Package /= No_Package then
+ declare
+ Defaults : constant Array_Element_Id :=
+ Value_Of
+ (Name => Name_Default_Switches,
+ In_Arrays =>
+ In_Tree.Shared.Packages.Table
+ (Binder_Package).Decl.Arrays,
+ Shared => In_Tree.Shared);
+
+ Switches : Variable_Value := Nil_Variable_Value;
+ Switch : String_List_Id := Nil_String;
+
+ begin
+ if Defaults /= No_Array_Element then
+ Switches :=
+ Value_Of
+ (Index => Name_Ada,
+ Src_Index => 0,
+ In_Array => Defaults,
+ Shared => In_Tree.Shared);
+
+ if not Switches.Default then
+ Switch := Switches.Values;
+
+ while Switch /= Nil_String loop
+ Add_Argument
+ (Get_Name_String
+ (In_Tree.Shared.String_Elements.Table
+ (Switch).Value));
+ Switch := In_Tree.Shared.String_Elements.
+ Table (Switch).Next;
+ end loop;
+ end if;
+ end if;
+ end;
+ end if;
+ end;
+ end if;
+
+ -- Get all the ALI files of the project file. We do that even if
+ -- Bind is False, so that First_ALI is set.
+
+ declare
+ Unit : Unit_Index;
+
+ begin
+ Library_ALIs.Reset;
+ Interface_ALIs.Reset;
+ Processed_ALIs.Reset;
+
+ Unit := Units_Htable.Get_First (In_Tree.Units_HT);
+ while Unit /= No_Unit_Index loop
+ if Unit.File_Names (Impl) /= null
+ and then not Unit.File_Names (Impl).Locally_Removed
+ then
+ if Check_Project (Unit.File_Names (Impl).Project) then
+ if Unit.File_Names (Spec) = null then
+
+ -- Add the ALI file only if it is not a subunit
+
+ declare
+ Src_Ind : constant Source_File_Index :=
+ Sinput.P.Load_Project_File
+ (Get_Name_String
+ (Unit.File_Names (Impl).Path.Name));
+ begin
+ if not
+ Sinput.P.Source_File_Is_Subunit (Src_Ind)
+ then
+ Add_ALI_For (Unit.File_Names (Impl).File);
+ exit when not Bind;
+ end if;
+ end;
+
+ else
+ Add_ALI_For (Unit.File_Names (Impl).File);
+ exit when not Bind;
+ end if;
+ end if;
+
+ elsif Unit.File_Names (Spec) /= null
+ and then not Unit.File_Names (Spec).Locally_Removed
+ and then Check_Project (Unit.File_Names (Spec).Project)
+ then
+ Add_ALI_For (Unit.File_Names (Spec).File);
+ exit when not Bind;
+ end if;
+
+ Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
+ end loop;
+ end;
+
+ -- Continue setup and call gnatbind if Bind is True
+
+ if Bind then
+
+ -- Get an eventual --RTS from the ALI file
+
+ if First_ALI /= No_File then
+ declare
+ T : Text_Buffer_Ptr;
+ A : ALI_Id;
+
+ begin
+ -- Load the ALI file
+
+ T := Read_Library_Info (First_ALI, True);
+
+ -- Read it
+
+ A := Scan_ALI
+ (First_ALI, T, Ignore_ED => False, Err => False);
+
+ if A /= No_ALI_Id then
+ for Index in
+ ALI.Units.Table
+ (ALI.ALIs.Table (A).First_Unit).First_Arg ..
+ ALI.Units.Table
+ (ALI.ALIs.Table (A).First_Unit).Last_Arg
+ loop
+ -- If --RTS found, add switch to call gnatbind
+
+ declare
+ Arg : String_Ptr renames Args.Table (Index);
+ begin
+ if Arg'Length >= 6 and then
+ Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
+ then
+ Add_Argument (Arg.all);
+ exit;
+ end if;
+ end;
+ end loop;
+ end if;
+ end;
+ end if;
+
+ -- Set the paths
+
+ -- First the source path
+
+ if For_Project.Include_Path_File = No_Path then
+ Get_Directories
+ (Project_Tree => In_Tree,
+ For_Project => For_Project,
+ Activity => Compilation,
+ Languages => Ada_Only);
+
+ Create_New_Path_File
+ (In_Tree.Shared, Path_FD, For_Project.Include_Path_File);
+
+ Write_Path_File (Path_FD);
+ Path_FD := Invalid_FD;
+ end if;
+
+ if Current_Source_Path_File_Of (In_Tree.Shared) /=
+ For_Project.Include_Path_File
+ then
+ Set_Current_Source_Path_File_Of
+ (In_Tree.Shared, For_Project.Include_Path_File);
+ Set_Path_File_Var
+ (Project_Include_Path_File,
+ Get_Name_String (For_Project.Include_Path_File));
+ end if;
+
+ -- Then, the object path
+
+ Get_Directories
+ (Project_Tree => In_Tree,
+ For_Project => For_Project,
+ Activity => SAL_Binding,
+ Languages => Ada_Only);
+
+ declare
+ Path_File_Name : Path_Name_Type;
+
+ begin
+ Create_New_Path_File (In_Tree.Shared, Path_FD, Path_File_Name);
+
+ Write_Path_File (Path_FD);
+ Path_FD := Invalid_FD;
+
+ Set_Path_File_Var
+ (Project_Objects_Path_File, Get_Name_String (Path_File_Name));
+ Set_Current_Source_Path_File_Of
+ (In_Tree.Shared, Path_File_Name);
+ end;
+
+ -- Display the gnatbind command, if not in quiet output
+
+ Display (Gnatbind);
+
+ Size := 0;
+ for J in 1 .. Argument_Number loop
+ Size := Size + Arguments (J)'Length + 1;
+ end loop;
+
+ -- Invoke gnatbind with the arguments if the size is not too large
+
+ if Size <= Maximum_Size then
+ Spawn
+ (Gnatbind_Path.all,
+ Arguments (1 .. Argument_Number),
+ Success);
+
+ -- Otherwise create a temporary response file
+
+ else
+ declare
+ FD : File_Descriptor;
+ Path : Path_Name_Type;
+ Args : Argument_List (1 .. 1);
+ EOL : constant String (1 .. 1) := (1 => ASCII.LF);
+ Status : Integer;
+ Succ : Boolean;
+ Quotes_Needed : Boolean;
+ Last_Char : Natural;
+ Ch : Character;
+
+ begin
+ Tempdir.Create_Temp_File (FD, Path);
+ Args (1) := new String'("@" & Get_Name_String (Path));
+
+ for J in 1 .. Argument_Number loop
+
+ -- Check if the argument should be quoted
+
+ Quotes_Needed := False;
+ Last_Char := Arguments (J)'Length;
+
+ for K in Arguments (J)'Range loop
+ Ch := Arguments (J) (K);
+
+ if Ch = ' ' or else Ch = ASCII.HT or else Ch = '"' then
+ Quotes_Needed := True;
+ exit;
+ end if;
+ end loop;
+
+ if Quotes_Needed then
+
+ -- Quote the argument, doubling '"'
+
+ declare
+ Arg : String (1 .. Arguments (J)'Length * 2 + 2);
+
+ begin
+ Arg (1) := '"';
+ Last_Char := 1;
+
+ for K in Arguments (J)'Range loop
+ Ch := Arguments (J) (K);
+ Last_Char := Last_Char + 1;
+ Arg (Last_Char) := Ch;
+
+ if Ch = '"' then
+ Last_Char := Last_Char + 1;
+ Arg (Last_Char) := '"';
+ end if;
+ end loop;
+
+ Last_Char := Last_Char + 1;
+ Arg (Last_Char) := '"';
+
+ Status := Write (FD, Arg'Address, Last_Char);
+ end;
+
+ else
+ Status := Write
+ (FD,
+ Arguments (J) (Arguments (J)'First)'Address,
+ Last_Char);
+ end if;
+
+ if Status /= Last_Char then
+ Fail ("disk full");
+ end if;
+
+ Status := Write (FD, EOL (1)'Address, 1);
+
+ if Status /= 1 then
+ Fail ("disk full");
+ end if;
+ end loop;
+
+ Close (FD);
+
+ -- And invoke gnatbind with this response file
+
+ Spawn (Gnatbind_Path.all, Args, Success);
+
+ Delete_File (Get_Name_String (Path), Succ);
+
+ -- We ignore a failure in this Delete_File operation.
+ -- Is that OK??? If so, worth a comment as to why we
+ -- are OK with the operation failing
+ end;
+ end if;
+
+ if not Success then
+ Com.Fail ("could not bind standalone library "
+ & Get_Name_String (For_Project.Library_Name));
+ end if;
+ end if;
+
+ -- Compile the binder generated file only if Link is true
+
+ if Link then
+
+ -- Set the paths
+
+ Set_Ada_Paths
+ (Project => For_Project,
+ In_Tree => In_Tree,
+ Including_Libraries => True);
+
+ -- Invoke <gcc> -c b__<lib>.adb
+
+ -- Allocate Arguments, if first time we see a standalone library
+
+ if Arguments = No_Argument then
+ Arguments := new String_List (1 .. Initial_Argument_Max);
+ end if;
+
+ Argument_Number := 2;
+ Arguments (1) := Compile_Switch;
+ Arguments (2) := No_Warning;
+
+ if OpenVMS_On_Target then
+ B_Start := new String'("b__");
+ end if;
+
+ Add_Argument
+ (B_Start.all
+ & Get_Name_String (For_Project.Library_Name) & ".adb");
+
+ -- If necessary, add the PIC option
+
+ if PIC_Option /= "" then
+ Add_Argument (PIC_Option);
+ end if;
+
+ -- Get the back-end switches and --RTS from the ALI file
+
+ if First_ALI /= No_File then
+ declare
+ T : Text_Buffer_Ptr;
+ A : ALI_Id;
+
+ begin
+ -- Load the ALI file
+
+ T := Read_Library_Info (First_ALI, True);
+
+ -- Read it
+
+ A :=
+ Scan_ALI (First_ALI, T, Ignore_ED => False, Err => False);
+
+ if A /= No_ALI_Id then
+ for Index in
+ ALI.Units.Table
+ (ALI.ALIs.Table (A).First_Unit).First_Arg ..
+ ALI.Units.Table
+ (ALI.ALIs.Table (A).First_Unit).Last_Arg
+ loop
+ -- Do not compile with the front end switches except
+ -- for --RTS.
+
+ declare
+ Arg : String_Ptr renames Args.Table (Index);
+ begin
+ if not Is_Front_End_Switch (Arg.all)
+ or else
+ Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
+ then
+ Add_Argument (Arg.all);
+ end if;
+ end;
+ end loop;
+ end if;
+ end;
+ end if;
+
+ -- Now all the arguments are set, compile binder generated file
+
+ Display (Gcc);
+ Spawn
+ (Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
+
+ if not Success then
+ Com.Fail
+ ("could not compile binder generated file for library "
+ & Get_Name_String (For_Project.Library_Name));
+ end if;
+
+ -- Process binder generated file for pragmas Linker_Options
+
+ Process_Binder_File (Arguments (3).all & ASCII.NUL);
+ end if;
+ end if;
+
+ -- Build the library only if Link is True
+
+ if Link then
+
+ -- If attributes Library_GCC or Linker'Driver were specified, get the
+ -- driver name.
+
+ if For_Project.Config.Shared_Lib_Driver /= No_File then
+ Driver_Name := Name_Id (For_Project.Config.Shared_Lib_Driver);
+ end if;
+
+ -- If attribute Library_Options was specified, add these options
+
+ Library_Options := Value_Of
+ (Name_Library_Options, For_Project.Decl.Attributes,
+ In_Tree.Shared);
+
+ if not Library_Options.Default then
+ declare
+ Current : String_List_Id;
+ Element : String_Element;
+
+ begin
+ Current := Library_Options.Values;
+ while Current /= Nil_String loop
+ Element := In_Tree.Shared.String_Elements.Table (Current);
+ Get_Name_String (Element.Value);
+
+ if Name_Len /= 0 then
+ Opts.Increment_Last;
+ Opts.Table (Opts.Last) :=
+ new String'(Name_Buffer (1 .. Name_Len));
+ end if;
+
+ Current := Element.Next;
+ end loop;
+ end;
+ end if;
+
+ Lib_Dirpath :=
+ new String'(Get_Name_String (For_Project.Library_Dir.Display_Name));
+ Lib_Filename :=
+ new String'(Get_Name_String (For_Project.Library_Name));
+
+ case For_Project.Library_Kind is
+ when Static =>
+ The_Build_Mode := Static;
+
+ when Dynamic =>
+ The_Build_Mode := Dynamic;
+
+ when Relocatable =>
+ The_Build_Mode := Relocatable;
+
+ if PIC_Option /= "" then
+ Opts.Increment_Last;
+ Opts.Table (Opts.Last) := new String'(PIC_Option);
+ end if;
+ end case;
+
+ -- Get the library version, if any
+
+ if For_Project.Lib_Internal_Name /= No_Name then
+ Lib_Version :=
+ new String'(Get_Name_String (For_Project.Lib_Internal_Name));
+ end if;
+
+ -- Add the objects found in the object directory and the object
+ -- directories of the extended files, if any, except for generated
+ -- object files (b~.. or B__..) from extended projects.
+ -- When there are one or more extended files, only add an object file
+ -- if no object file with the same name have already been added.
+
+ In_Main_Object_Directory := True;
+
+ -- For gnatmake, when the project specifies more than just Ada as a
+ -- language (even if course we could not find any source file for
+ -- the other languages), we will take all object files found in the
+ -- object directories. Since we know the project supports at least
+ -- Ada, we just have to test whether it has at least two languages,
+ -- and not care about the sources.
+
+ Foreign_Sources := For_Project.Languages.Next /= null;
+ Current_Proj := For_Project;
+ loop
+ if Current_Proj.Object_Directory /= No_Path_Information then
+
+ -- The following code gets far too indented ... suggest some
+ -- procedural abstraction here. How about making this declare
+ -- block a named procedure???
+
+ declare
+ Object_Dir_Path : constant String :=
+ Get_Name_String
+ (Current_Proj.Object_Directory
+ .Display_Name);
+
+ Object_Dir : Dir_Type;
+ Filename : String (1 .. 255);
+ Last : Natural;
+ Id : Name_Id;
+
+ begin
+ Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path);
+
+ -- For all entries in the object directory
+
+ loop
+ Read (Object_Dir, Filename, Last);
+
+ exit when Last = 0;
+
+ -- Check if it is an object file
+
+ if Is_Obj (Filename (1 .. Last)) then
+ declare
+ Object_Path : constant String :=
+ Normalize_Pathname
+ (Object_Dir_Path
+ & Directory_Separator
+ & Filename (1 .. Last));
+ Object_File : constant String :=
+ Filename (1 .. Last);
+
+ C_Filename : String := Object_File;
+
+ begin
+ Canonical_Case_File_Name (C_Filename);
+
+ -- If in the object directory of an extended
+ -- project, do not consider generated object files.
+
+ if In_Main_Object_Directory
+ or else Last < 5
+ or else
+ C_Filename (1 .. B_Start'Length) /= B_Start.all
+ then
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (C_Filename);
+ Id := Name_Find;
+
+ if not Objects_Htable.Get (Id) then
+ declare
+ ALI_File : constant String :=
+ Ext_To (C_Filename, "ali");
+
+ ALI_Path : constant String :=
+ Ext_To (Object_Path, "ali");
+
+ Add_It : Boolean;
+ Fname : File_Name_Type;
+ Proj : Project_Id;
+ Index : Unit_Index;
+
+ begin
+ -- The following assignment could use
+ -- a comment ???
+
+ Add_It :=
+ Foreign_Sources
+ or else
+ (Last >= 5
+ and then
+ C_Filename (1 .. B_Start'Length)
+ = B_Start.all);
+
+ if Is_Regular_File (ALI_Path) then
+
+ -- If there is an ALI file, check if
+ -- the object file should be added to
+ -- the library. If there are foreign
+ -- sources we put all object files in
+ -- the library.
+
+ if not Add_It then
+ Index :=
+ Units_Htable.Get_First
+ (In_Tree.Units_HT);
+ while Index /= null loop
+ if Index.File_Names (Impl) /=
+ null
+ then
+ Proj :=
+ Index.File_Names (Impl)
+ .Project;
+ Fname :=
+ Index.File_Names (Impl).File;
+
+ elsif Index.File_Names (Spec) /=
+ null
+ then
+ Proj :=
+ Index.File_Names (Spec)
+ .Project;
+ Fname :=
+ Index.File_Names (Spec).File;
+
+ else
+ Proj := No_Project;
+ end if;
+
+ Add_It := Proj /= No_Project;
+
+ -- If the source is in the
+ -- project or a project it
+ -- extends, we may put it in
+ -- the library.
+
+ if Add_It then
+ Add_It := Check_Project (Proj);
+ end if;
+
+ -- But we don't, if the ALI file
+ -- does not correspond to the
+ -- unit.
+
+ if Add_It then
+ declare
+ F : constant String :=
+ Ext_To
+ (Get_Name_String
+ (Fname), "ali");
+ begin
+ Add_It := F = ALI_File;
+ end;
+ end if;
+
+ exit when Add_It;
+
+ Index :=
+ Units_Htable.Get_Next
+ (In_Tree.Units_HT);
+ end loop;
+ end if;
+
+ if Add_It then
+ Objects_Htable.Set (Id, True);
+ Objects.Append
+ (new String'(Object_Path));
+
+ -- Record the ALI file
+
+ ALIs.Append (new String'(ALI_Path));
+
+ -- Find out if for this ALI file,
+ -- libgnarl or libdecgnat is
+ -- necessary.
+
+ Check_Libs (ALI_Path, True);
+ end if;
+
+ elsif Foreign_Sources then
+ Objects.Append
+ (new String'(Object_Path));
+ end if;
+ end;
+ end if;
+ end if;
+ end;
+ end if;
+ end loop;
+
+ Close (Dir => Object_Dir);
+
+ exception
+ when Directory_Error =>
+ Com.Fail ("cannot find object directory """
+ & Get_Name_String
+ (Current_Proj.Object_Directory.Display_Name)
+ & """");
+ end;
+ end if;
+
+ exit when Current_Proj.Extends = No_Project;
+
+ In_Main_Object_Directory := False;
+ Current_Proj := Current_Proj.Extends;
+ end loop;
+
+ -- Add the -L and -l switches for the imported Library Project Files,
+ -- and, if Path Option is supported, the library directory path names
+ -- to Rpath.
+
+ Process_Imported_Libraries;
+
+ -- Link with libgnat and possibly libgnarl
+
+ Opts.Increment_Last;
+ Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory);
+
+ -- If Path Option supported, add libgnat directory path name to Rpath
+
+ if Path_Option /= null then
+ declare
+ Libdir : constant String := Lib_Directory;
+ GCC_Index : Natural := 0;
+
+ begin
+ Add_Rpath (Libdir);
+
+ -- For shared libraries, add to the Path Option the directory
+ -- of the shared version of libgcc.
+
+ if The_Build_Mode /= Static then
+ GCC_Index := Index (Libdir, "/lib/");
+
+ if GCC_Index = 0 then
+ GCC_Index :=
+ Index
+ (Libdir,
+ Directory_Separator & "lib" & Directory_Separator);
+ end if;
+
+ if GCC_Index /= 0 then
+ Add_Rpath (Libdir (Libdir'First .. GCC_Index + 3));
+ end if;
+ end if;
+ end;
+ end if;
+
+ if Libgnarl_Needed = Yes then
+ Opts.Increment_Last;
+
+ if The_Build_Mode = Static then
+ Opts.Table (Opts.Last) := new String'("-lgnarl");
+ else
+ Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnarl"));
+ end if;
+ end if;
+
+ if Libdecgnat_Needed then
+ Opts.Increment_Last;
+
+ Opts.Table (Opts.Last) :=
+ new String'("-L" & Lib_Directory & "/../declib");
+
+ Opts.Increment_Last;
+
+ if The_Build_Mode = Static then
+ Opts.Table (Opts.Last) := new String'("-ldecgnat");
+ else
+ Opts.Table (Opts.Last) := new String'(Shared_Lib ("decgnat"));
+ end if;
+ end if;
+
+ Opts.Increment_Last;
+
+ if The_Build_Mode = Static then
+ Opts.Table (Opts.Last) := new String'("-lgnat");
+ else
+ Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnat"));
+ end if;
+
+ -- If Path Option is supported, add the necessary switch with the
+ -- content of Rpath. As Rpath contains at least libgnat directory
+ -- path name, it is guaranteed that it is not null.
+
+ if Opt.Run_Path_Option and then Path_Option /= null then
+ Opts.Increment_Last;
+ Opts.Table (Opts.Last) :=
+ new String'(Path_Option.all & Rpath (1 .. Rpath_Last));
+ Free (Path_Option);
+ Free (Rpath);
+ end if;
+
+ Object_Files :=
+ new Argument_List'
+ (Argument_List (Objects.Table (1 .. Objects.Last)));
+
+ Ali_Files :=
+ new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
+
+ Options :=
+ new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
+
+ -- We fail if there are no object to put in the library
+ -- (Ada or foreign objects).
+
+ if Object_Files'Length = 0 then
+ Com.Fail ("no object files for library """ &
+ Lib_Filename.all & '"');
+ end if;
+
+ if not Opt.Quiet_Output then
+ Write_Eol;
+ Write_Str ("building ");
+ Write_Str (Ada.Characters.Handling.To_Lower
+ (Build_Mode_State'Image (The_Build_Mode)));
+ Write_Str (" library for project ");
+ Write_Line (Project_Name);
+
+ -- Only output list of object files and ALI files in verbose mode
+
+ if Opt.Verbose_Mode then
+ Write_Eol;
+
+ Write_Line ("object files:");
+
+ for Index in Object_Files'Range loop
+ Write_Str (" ");
+ Write_Line (Object_Files (Index).all);
+ end loop;
+
+ Write_Eol;
+
+ if Ali_Files'Length = 0 then
+ Write_Line ("NO ALI files");
+
+ else
+ Write_Line ("ALI files:");
+
+ for Index in Ali_Files'Range loop
+ Write_Str (" ");
+ Write_Line (Ali_Files (Index).all);
+ end loop;
+ end if;
+
+ Write_Eol;
+ end if;
+ end if;
+
+ -- We check that all object files are regular files
+
+ Check_Context;
+
+ -- Delete the existing library file, if it exists. Fail if the
+ -- library file is not writable, or if it is not possible to delete
+ -- the file.
+
+ declare
+ DLL_Name : aliased String :=
+ Lib_Dirpath.all & Directory_Separator & DLL_Prefix &
+ Lib_Filename.all & "." & DLL_Ext;
+
+ Archive_Name : aliased String :=
+ Lib_Dirpath.all & Directory_Separator & "lib" &
+ Lib_Filename.all & "." & Archive_Ext;
+
+ type Str_Ptr is access all String;
+ -- This type is necessary to meet the accessibility rules of Ada.
+ -- It is not possible to use String_Access here.
+
+ Full_Lib_Name : Str_Ptr;
+ -- Designates the full library path name. Either DLL_Name or
+ -- Archive_Name, depending on the library kind.
+
+ Success : Boolean;
+ pragma Warnings (Off, Success);
+ -- Used to call Delete_File
+
+ begin
+ if The_Build_Mode = Static then
+ Full_Lib_Name := Archive_Name'Access;
+ else
+ Full_Lib_Name := DLL_Name'Access;
+ end if;
+
+ if Is_Regular_File (Full_Lib_Name.all) then
+ if Is_Writable_File (Full_Lib_Name.all) then
+ Delete_File (Full_Lib_Name.all, Success);
+ end if;
+
+ if Is_Regular_File (Full_Lib_Name.all) then
+ Com.Fail ("could not delete """ & Full_Lib_Name.all & """");
+ end if;
+ end if;
+ end;
+
+ Argument_Number := 0;
+
+ -- If we have a standalone library, gather all the interface ALI.
+ -- They are passed to Build_Dynamic_Library, where they are used by
+ -- some platforms (VMS, for example) to decide what symbols should be
+ -- exported. They are also flagged as Interface when we copy them to
+ -- the library directory (by Copy_ALI_Files, below).
+
+ if Standalone then
+ Current_Proj := For_Project;
+
+ declare
+ Iface : String_List_Id := For_Project.Lib_Interface_ALIs;
+ ALI : File_Name_Type;
+
+ begin
+ while Iface /= Nil_String loop
+ ALI :=
+ File_Name_Type
+ (In_Tree.Shared.String_Elements.Table (Iface).Value);
+ Interface_ALIs.Set (ALI, True);
+ Get_Name_String
+ (In_Tree.Shared.String_Elements.Table (Iface).Value);
+ Add_Argument (Name_Buffer (1 .. Name_Len));
+ Iface := In_Tree.Shared.String_Elements.Table (Iface).Next;
+ end loop;
+
+ Iface := For_Project.Lib_Interface_ALIs;
+
+ if not Opt.Quiet_Output then
+
+ -- Check that the interface set is complete: any unit in the
+ -- library that is needed by an interface should also be an
+ -- interface. If it is not the case, output a warning.
+
+ while Iface /= Nil_String loop
+ ALI :=
+ File_Name_Type
+ (In_Tree.Shared.String_Elements.Table (Iface).Value);
+ Process (ALI);
+ Iface :=
+ In_Tree.Shared.String_Elements.Table (Iface).Next;
+ end loop;
+ end if;
+ end;
+ end if;
+
+ declare
+ Current_Dir : constant String := Get_Current_Dir;
+ Dir : Dir_Type;
+
+ Name : String (1 .. 200);
+ Last : Natural;
+
+ Disregard : Boolean;
+ pragma Warnings (Off, Disregard);
+
+ DLL_Name : aliased constant String :=
+ Lib_Filename.all & "." & DLL_Ext;
+
+ Archive_Name : aliased constant String :=
+ Lib_Filename.all & "." & Archive_Ext;
+
+ Delete : Boolean := False;
+
+ begin
+ -- Clean the library directory: remove any file with the name of
+ -- the library file and any ALI file of a source of the project.
+
+ begin
+ Get_Name_String (For_Project.Library_Dir.Display_Name);
+ Change_Dir (Name_Buffer (1 .. Name_Len));
+
+ exception
+ when others =>
+ Com.Fail
+ ("unable to access library directory """
+ & Name_Buffer (1 .. Name_Len)
+ & """");
+ end;
+
+ Open (Dir, ".");
+
+ loop
+ Read (Dir, Name, Last);
+ exit when Last = 0;
+
+ declare
+ Filename : constant String := Name (1 .. Last);
+
+ begin
+ if Is_Regular_File (Filename) then
+ Canonical_Case_File_Name (Name (1 .. Last));
+ Delete := False;
+
+ if (The_Build_Mode = Static
+ and then Name (1 .. Last) = Archive_Name)
+ or else
+ ((The_Build_Mode = Dynamic
+ or else
+ The_Build_Mode = Relocatable)
+ and then Name (1 .. Last) = DLL_Name)
+ then
+ Delete := True;
+
+ elsif Last > 4
+ and then Name (Last - 3 .. Last) = ".ali"
+ then
+ declare
+ Unit : Unit_Index;
+
+ begin
+ -- Compare with ALI file names of the project
+
+ Unit := Units_Htable.Get_First (In_Tree.Units_HT);
+ while Unit /= No_Unit_Index loop
+ if Unit.File_Names (Impl) /= null
+ and then Unit.File_Names (Impl).Project /=
+ No_Project
+ then
+ if Ultimate_Extending_Project_Of
+ (Unit.File_Names (Impl).Project) =
+ For_Project
+ then
+ Get_Name_String
+ (Unit.File_Names (Impl).File);
+ Name_Len :=
+ Name_Len -
+ File_Extension
+ (Name (1 .. Name_Len))'Length;
+
+ if Name_Buffer (1 .. Name_Len) =
+ Name (1 .. Last - 4)
+ then
+ Delete := True;
+ exit;
+ end if;
+ end if;
+
+ elsif Unit.File_Names (Spec) /= null
+ and then Ultimate_Extending_Project_Of
+ (Unit.File_Names (Spec).Project) =
+ For_Project
+ then
+ Get_Name_String (Unit.File_Names (Spec).File);
+ Name_Len :=
+ Name_Len -
+ File_Extension (Name (1 .. Last))'Length;
+
+ if Name_Buffer (1 .. Name_Len) =
+ Name (1 .. Last - 4)
+ then
+ Delete := True;
+ exit;
+ end if;
+ end if;
+
+ Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
+ end loop;
+ end;
+ end if;
+
+ if Delete then
+ Set_Writable (Filename);
+ Delete_File (Filename, Disregard);
+ end if;
+ end if;
+ end;
+ end loop;
+
+ Close (Dir);
+
+ Change_Dir (Current_Dir);
+ end;
+
+ -- Call procedure to build the library, depending on the build mode
+
+ case The_Build_Mode is
+ when Dynamic | Relocatable =>
+ Build_Dynamic_Library
+ (Ofiles => Object_Files.all,
+ Options => Options.all,
+ Interfaces => Arguments (1 .. Argument_Number),
+ Lib_Filename => Lib_Filename.all,
+ Lib_Dir => Lib_Dirpath.all,
+ Symbol_Data => Current_Proj.Symbol_Data,
+ Driver_Name => Driver_Name,
+ Lib_Version => Lib_Version.all,
+ Auto_Init => Current_Proj.Lib_Auto_Init);
+
+ when Static =>
+ MLib.Build_Library
+ (Object_Files.all,
+ Lib_Filename.all,
+ Lib_Dirpath.all);
+
+ when None =>
+ null;
+ end case;
+
+ -- We need to copy the ALI files from the object directory to the
+ -- library ALI directory, so that the linker find them there, and
+ -- does not need to look in the object directory where it would also
+ -- find the object files; and we don't want that: we want the linker
+ -- to use the library.
+
+ -- Copy the ALI files and make the copies read-only. For interfaces,
+ -- mark the copies as interfaces.
+
+ Copy_ALI_Files
+ (Files => Ali_Files.all,
+ To => For_Project.Library_ALI_Dir.Display_Name,
+ Interfaces => Arguments (1 .. Argument_Number));
+
+ -- Copy interface sources if Library_Src_Dir specified
+
+ if Standalone
+ and then For_Project.Library_Src_Dir /= No_Path_Information
+ then
+ -- Clean the interface copy directory: remove any source that
+ -- could be a source of the project.
+
+ begin
+ Get_Name_String (For_Project.Library_Src_Dir.Display_Name);
+ Change_Dir (Name_Buffer (1 .. Name_Len));
+
+ exception
+ when others =>
+ Com.Fail
+ ("unable to access library source copy directory """
+ & Name_Buffer (1 .. Name_Len)
+ & """");
+ end;
+
+ declare
+ Dir : Dir_Type;
+ Delete : Boolean := False;
+ Unit : Unit_Index;
+
+ Name : String (1 .. 200);
+ Last : Natural;
+
+ Disregard : Boolean;
+ pragma Warnings (Off, Disregard);
+
+ begin
+ Open (Dir, ".");
+
+ loop
+ Read (Dir, Name, Last);
+ exit when Last = 0;
+
+ if Is_Regular_File (Name (1 .. Last)) then
+ Canonical_Case_File_Name (Name (1 .. Last));
+ Delete := False;
+
+ -- Compare with source file names of the project
+
+ Unit := Units_Htable.Get_First (In_Tree.Units_HT);
+ while Unit /= No_Unit_Index loop
+ if Unit.File_Names (Impl) /= null
+ and then Ultimate_Extending_Project_Of
+ (Unit.File_Names (Impl).Project) = For_Project
+ and then
+ Get_Name_String
+ (Unit.File_Names (Impl).File) =
+ Name (1 .. Last)
+ then
+ Delete := True;
+ exit;
+ end if;
+
+ if Unit.File_Names (Spec) /= null
+ and then Ultimate_Extending_Project_Of
+ (Unit.File_Names (Spec).Project) =
+ For_Project
+ and then
+ Get_Name_String
+ (Unit.File_Names (Spec).File) =
+ Name (1 .. Last)
+ then
+ Delete := True;
+ exit;
+ end if;
+
+ Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
+ end loop;
+ end if;
+
+ if Delete then
+ Set_Writable (Name (1 .. Last));
+ Delete_File (Name (1 .. Last), Disregard);
+ end if;
+ end loop;
+
+ Close (Dir);
+ end;
+
+ Copy_Interface_Sources
+ (For_Project => For_Project,
+ In_Tree => In_Tree,
+ Interfaces => Arguments (1 .. Argument_Number),
+ To_Dir => For_Project.Library_Src_Dir.Display_Name);
+ end if;
+ end if;
+
+ -- Reset the current working directory to its previous value
+
+ Change_Dir (Current_Dir);
+ end Build_Library;
+
+ -----------
+ -- Check --
+ -----------
+
+ procedure Check (Filename : String) is
+ begin
+ if not Is_Regular_File (Filename) then
+ Com.Fail (Filename & " not found.");
+ end if;
+ end Check;
+
+ -------------------
+ -- Check_Context --
+ -------------------
+
+ procedure Check_Context is
+ begin
+ -- Check that each object file exists
+
+ for F in Object_Files'Range loop
+ Check (Object_Files (F).all);
+ end loop;
+ end Check_Context;
+
+ -------------------
+ -- Check_Library --
+ -------------------
+
+ procedure Check_Library
+ (For_Project : Project_Id; In_Tree : Project_Tree_Ref)
+ is
+ Lib_TS : Time_Stamp_Type;
+ Current : constant Dir_Name_Str := Get_Current_Dir;
+
+ begin
+ -- No need to build the library if there is no object directory,
+ -- hence no object files to build the library.
+
+ if For_Project.Library then
+ declare
+ Lib_Name : constant File_Name_Type :=
+ Library_File_Name_For (For_Project, In_Tree);
+ begin
+ Change_Dir
+ (Get_Name_String (For_Project.Library_Dir.Display_Name));
+ Lib_TS := File_Stamp (Lib_Name);
+ For_Project.Library_TS := Lib_TS;
+ end;
+
+ if not For_Project.Externally_Built
+ and then not For_Project.Need_To_Build_Lib
+ and then For_Project.Object_Directory /= No_Path_Information
+ then
+ declare
+ Obj_TS : Time_Stamp_Type;
+ Object_Dir : Dir_Type;
+
+ begin
+ if OpenVMS_On_Target then
+ B_Start := new String'("b__");
+ end if;
+
+ -- If the library file does not exist, then the time stamp will
+ -- be Empty_Time_Stamp, earlier than any other time stamp.
+
+ Change_Dir
+ (Get_Name_String (For_Project.Object_Directory.Display_Name));
+ Open (Dir => Object_Dir, Dir_Name => ".");
+
+ -- For all entries in the object directory
+
+ loop
+ Read (Object_Dir, Name_Buffer, Name_Len);
+ exit when Name_Len = 0;
+
+ -- Check if it is an object file, but ignore any binder
+ -- generated file.
+
+ if Is_Obj (Name_Buffer (1 .. Name_Len))
+ and then Name_Buffer (1 .. B_Start'Length) /= B_Start.all
+ then
+ -- Get the object file time stamp
+
+ Obj_TS := File_Stamp (File_Name_Type'(Name_Find));
+
+ -- If library file time stamp is earlier, set
+ -- Need_To_Build_Lib and return. String comparison is
+ -- used, otherwise time stamps may be too close and the
+ -- comparison would return True, which would trigger
+ -- an unnecessary rebuild of the library.
+
+ if String (Lib_TS) < String (Obj_TS) then
+
+ -- Library must be rebuilt
+
+ For_Project.Need_To_Build_Lib := True;
+ exit;
+ end if;
+ end if;
+ end loop;
+
+ Close (Object_Dir);
+ end;
+ end if;
+
+ Change_Dir (Current);
+ end if;
+ end Check_Library;
+
+ ----------------------------
+ -- Copy_Interface_Sources --
+ ----------------------------
+
+ procedure Copy_Interface_Sources
+ (For_Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Interfaces : Argument_List;
+ To_Dir : Path_Name_Type)
+ is
+ Current : constant Dir_Name_Str := Get_Current_Dir;
+ -- The current directory, where to return to at the end
+
+ Target : constant Dir_Name_Str := Get_Name_String (To_Dir);
+ -- The directory where to copy sources
+
+ Text : Text_Buffer_Ptr;
+ The_ALI : ALI.ALI_Id;
+ Lib_File : File_Name_Type;
+
+ First_Unit : ALI.Unit_Id;
+ Second_Unit : ALI.Unit_Id;
+
+ Copy_Subunits : Boolean := False;
+ -- When True, indicates that subunits, if any, need to be copied too
+
+ procedure Copy (File_Name : File_Name_Type);
+ -- Copy one source of the project to the target directory
+
+ ----------
+ -- Copy --
+ ----------
+
+ procedure Copy (File_Name : File_Name_Type) is
+ Success : Boolean;
+ pragma Warnings (Off, Success);
+
+ Source : Standard.Prj.Source_Id;
+ begin
+ Source := Find_Source
+ (In_Tree, For_Project,
+ In_Extended_Only => True,
+ Base_Name => File_Name);
+
+ if Source /= No_Source
+ and then not Source.Locally_Removed
+ and then Source.Replaced_By = No_Source
+ then
+ Copy_File
+ (Get_Name_String (Source.Path.Name),
+ Target,
+ Success,
+ Mode => Overwrite,
+ Preserve => Preserve);
+ end if;
+ end Copy;
+
+ -- Start of processing for Copy_Interface_Sources
+
+ begin
+ -- Change the working directory to the object directory
+
+ Change_Dir (Get_Name_String (For_Project.Object_Directory.Display_Name));
+
+ for Index in Interfaces'Range loop
+
+ -- First, load the ALI file
+
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Interfaces (Index).all);
+ Lib_File := Name_Find;
+ Text := Read_Library_Info (Lib_File);
+ The_ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
+ Free (Text);
+
+ Second_Unit := No_Unit_Id;
+ First_Unit := ALI.ALIs.Table (The_ALI).First_Unit;
+ Copy_Subunits := True;
+
+ -- If there is both a spec and a body, check if they are both needed
+
+ if ALI.Units.Table (First_Unit).Utype = Is_Body then
+ Second_Unit := ALI.ALIs.Table (The_ALI).Last_Unit;
+
+ -- If the body is not needed, then reset First_Unit
+
+ if not ALI.Units.Table (Second_Unit).Body_Needed_For_SAL then
+ First_Unit := No_Unit_Id;
+ Copy_Subunits := False;
+ end if;
+
+ elsif ALI.Units.Table (First_Unit).Utype = Is_Spec_Only then
+ Copy_Subunits := False;
+ end if;
+
+ -- Copy the file(s) that need to be copied
+
+ if First_Unit /= No_Unit_Id then
+ Copy (File_Name => ALI.Units.Table (First_Unit).Sfile);
+ end if;
+
+ if Second_Unit /= No_Unit_Id then
+ Copy (File_Name => ALI.Units.Table (Second_Unit).Sfile);
+ end if;
+
+ -- Copy all the separates, if any
+
+ if Copy_Subunits then
+ for Dep in ALI.ALIs.Table (The_ALI).First_Sdep ..
+ ALI.ALIs.Table (The_ALI).Last_Sdep
+ loop
+ if Sdep.Table (Dep).Subunit_Name /= No_Name then
+ Copy (File_Name => Sdep.Table (Dep).Sfile);
+ end if;
+ end loop;
+ end if;
+ end loop;
+
+ -- Restore the initial working directory
+
+ Change_Dir (Current);
+ end Copy_Interface_Sources;
+
+ -------------
+ -- Display --
+ -------------
+
+ procedure Display (Executable : String) is
+ begin
+ if not Opt.Quiet_Output then
+ Write_Str (Executable);
+
+ for Index in 1 .. Argument_Number loop
+ Write_Char (' ');
+ Write_Str (Arguments (Index).all);
+
+ if not Opt.Verbose_Mode and then Index > 4 then
+ Write_Str (" ...");
+ exit;
+ end if;
+ end loop;
+
+ Write_Eol;
+ end if;
+ end Display;
+
+ -----------
+ -- Index --
+ -----------
+
+ function Index (S, Pattern : String) return Natural is
+ Len : constant Natural := Pattern'Length;
+
+ begin
+ for J in reverse S'First .. S'Last - Len + 1 loop
+ if Pattern = S (J .. J + Len - 1) then
+ return J;
+ end if;
+ end loop;
+
+ return 0;
+ end Index;
+
+ -------------------------
+ -- Process_Binder_File --
+ -------------------------
+
+ procedure Process_Binder_File (Name : String) is
+ Fd : FILEs;
+ -- Binder file's descriptor
+
+ Read_Mode : constant String := "r" & ASCII.NUL;
+ -- For fopen
+
+ Status : Interfaces.C_Streams.int;
+ pragma Unreferenced (Status);
+ -- For fclose
+
+ Begin_Info : constant String := "-- BEGIN Object file/option list";
+ End_Info : constant String := "-- END Object file/option list ";
+
+ Next_Line : String (1 .. 1000);
+ -- Current line value
+ -- Where does this odd constant 1000 come from, looks suspicious ???
+
+ Nlast : Integer;
+ -- End of line slice (the slice does not contain the line terminator)
+
+ procedure Get_Next_Line;
+ -- Read the next line from the binder file without the line terminator
+
+ -------------------
+ -- Get_Next_Line --
+ -------------------
+
+ procedure Get_Next_Line is
+ Fchars : chars;
+
+ begin
+ Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
+
+ if Fchars = System.Null_Address then
+ Fail ("Error reading binder output");
+ end if;
+
+ Nlast := 1;
+ while Nlast <= Next_Line'Last
+ and then Next_Line (Nlast) /= ASCII.LF
+ and then Next_Line (Nlast) /= ASCII.CR
+ loop
+ Nlast := Nlast + 1;
+ end loop;
+
+ Nlast := Nlast - 1;
+ end Get_Next_Line;
+
+ -- Start of processing for Process_Binder_File
+
+ begin
+ Fd := fopen (Name'Address, Read_Mode'Address);
+
+ if Fd = NULL_Stream then
+ Fail ("Failed to open binder output");
+ end if;
+
+ -- Skip up to the Begin Info line
+
+ loop
+ Get_Next_Line;
+ exit when Next_Line (1 .. Nlast) = Begin_Info;
+ end loop;
+
+ -- Find the first switch
+
+ loop
+ Get_Next_Line;
+
+ exit when Next_Line (1 .. Nlast) = End_Info;
+
+ -- As the binder generated file is in Ada, remove the first eight
+ -- characters " -- ".
+
+ Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
+ Nlast := Nlast - 8;
+
+ -- Stop when the first switch is found
+
+ exit when Next_Line (1) = '-';
+ end loop;
+
+ if Next_Line (1 .. Nlast) /= End_Info then
+ loop
+ -- Ignore -static and -shared, since -shared will be used
+ -- in any case.
+
+ -- Ignore -lgnat, -lgnarl and -ldecgnat as they will be added
+ -- later, because they are also needed for non Stand-Alone shared
+ -- libraries.
+
+ -- Also ignore the shared libraries which are :
+
+ -- UNIX / Windows VMS
+ -- -lgnat-<version> -lgnat_<version> (7 + version'length chars)
+ -- -lgnarl-<version> -lgnarl_<version> (8 + version'length chars)
+
+ if Next_Line (1 .. Nlast) /= "-static" and then
+ Next_Line (1 .. Nlast) /= "-shared" and then
+ Next_Line (1 .. Nlast) /= "-ldecgnat" and then
+ Next_Line (1 .. Nlast) /= "-lgnarl" and then
+ Next_Line (1 .. Nlast) /= "-lgnat" and then
+ Next_Line
+ (1 .. Natural'Min (Nlast, 10 + Library_Version'Length)) /=
+ Shared_Lib ("decgnat") and then
+ Next_Line
+ (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
+ Shared_Lib ("gnarl") and then
+ Next_Line
+ (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /=
+ Shared_Lib ("gnat")
+ then
+ if Next_Line (1) /= '-' then
+
+ -- This is not an option, should we add it?
+
+ if Add_Object_Files then
+ Opts.Increment_Last;
+ Opts.Table (Opts.Last) :=
+ new String'(Next_Line (1 .. Nlast));
+ end if;
+
+ else
+ -- Add all other options
+
+ Opts.Increment_Last;
+ Opts.Table (Opts.Last) :=
+ new String'(Next_Line (1 .. Nlast));
+ end if;
+ end if;
+
+ -- Next option, if any
+
+ Get_Next_Line;
+ exit when Next_Line (1 .. Nlast) = End_Info;
+
+ -- Remove first eight characters " -- "
+
+ Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
+ Nlast := Nlast - 8;
+ end loop;
+ end if;
+
+ Status := fclose (Fd);
+
+ -- Is it really right to ignore any close error ???
+
+ end Process_Binder_File;
+
+ ------------------
+ -- Reset_Tables --
+ ------------------
+
+ procedure Reset_Tables is
+ begin
+ Objects.Init;
+ Objects_Htable.Reset;
+ ALIs.Init;
+ Opts.Init;
+ Processed_Projects.Reset;
+ Library_Projs.Init;
+ end Reset_Tables;
+
+ ---------------------------
+ -- SALs_Use_Constructors --
+ ---------------------------
+
+ function SALs_Use_Constructors return Boolean is
+ function C_SALs_Init_Using_Constructors return Integer;
+ pragma Import (C, C_SALs_Init_Using_Constructors,
+ "__gnat_sals_init_using_constructors");
+ begin
+ return C_SALs_Init_Using_Constructors /= 0;
+ end SALs_Use_Constructors;
+
+end MLib.Prj;