-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2004, Ada Core Technologies, Inc. --
+-- Copyright (C) 2001-2010, 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 2, or (at your option) any later ver- --
+-- 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 COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- 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 Hostparm;
with MLib.Fil; use MLib.Fil;
with MLib.Tgt; use MLib.Tgt;
with MLib.Utl; use MLib.Utl;
-with Namet; use Namet;
with Opt;
-with Osint; use Osint;
with Output; use Output;
with Prj.Com; use Prj.Com;
with Prj.Env; use Prj.Env;
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 GNAT.OS_Lib; use GNAT.OS_Lib;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System;
with System.Case_Util; use System.Case_Util;
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 aq stand-alone
- -- library.
- -- False for Windows, True for other platforms.
+ -- 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 := "b~";
- S_Osinte_Ads : Name_Id := No_Name;
+ 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 : Name_Id := No_Name;
+ S_Dec_Ads : File_Name_Type := No_File;
-- Name_Id for "dec.ads"
- No_Argument_List : aliased String_List := (1 .. 0 => null);
- No_Argument : constant String_List_Access := No_Argument_List'Access;
+ G_Trasym_Ads : File_Name_Type := No_File;
+ -- Name_Id for "g-trasym.ads"
Arguments : String_List_Access := No_Argument;
-- Used to accumulate arguments for the invocation of gnatbind and of
Compile_Switch_String : aliased String := "-c";
Compile_Switch : constant String_Access := Compile_Switch_String'Access;
+ Auto_Initialize : constant String := "-a";
+
-- List of objects to put inside the library
Object_Files : Argument_List_Access;
Table_Increment => 100);
package Objects_Htable is new GNAT.HTable.Simple_HTable
- (Header_Num => Com.Header_Num,
+ (Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Name_Id,
- Hash => Com.Hash,
+ Hash => Hash,
Equal => "=");
- -- List of non-Ada object files
-
- Foreign_Objects : Argument_List_Access;
-
- package Foreigns is new Table.Table
- (Table_Name => "Mlib.Prj.Foreigns",
- Table_Component_Type => String_Access,
- Table_Index_Type => Natural,
- Table_Low_Bound => 1,
- Table_Initial => 20,
- Table_Increment => 100);
-
-- List of ALI files
Ali_Files : Argument_List_Access;
Table_Initial => 50,
Table_Increment => 100);
- -- List of options set in the command line.
+ -- List of options set in the command line
Options : Argument_List_Access;
-- All the ALI file in the library
package Library_ALIs is new GNAT.HTable.Simple_HTable
- (Header_Num => Com.Header_Num,
+ (Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
- Key => Name_Id,
- Hash => Com.Hash,
+ 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 => Com.Header_Num,
+ (Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
- Key => Name_Id,
- Hash => Com.Hash,
+ 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 => Com.Header_Num,
+ (Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
- Key => Name_Id,
- Hash => Com.Hash,
+ Key => File_Name_Type,
+ Hash => Hash,
Equal => "=");
- -- The projects imported directly or indirectly.
+ -- The projects imported directly or indirectly
package Processed_Projects is new GNAT.HTable.Simple_HTable
- (Header_Num => Com.Header_Num,
+ (Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Name_Id,
- Hash => Com.Hash,
+ Hash => Hash,
Equal => "=");
- -- The library projects imported directly or indirectly.
+ -- The library projects imported directly or indirectly
package Library_Projs is new Table.Table (
Table_Component_Type => Project_Id,
type Build_Mode_State is (None, Static, Dynamic, Relocatable);
procedure Add_Argument (S : String);
- -- Add one argument to the array Arguments.
- -- If Arguments is full, double its size.
+ -- 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.
+ -- 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.
+ -- 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 Clean (Directory : Name_Id);
- -- Attempt to delete all files in Directory, but not subdirectories
-
procedure Copy_Interface_Sources
(For_Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Interfaces : Argument_List;
- To_Dir : Name_Id);
+ 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, Foreign_Objects, Ali_Files, Options).
+ -- (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 Build_Library
(For_Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Gnatbind : String;
Gnatbind_Path : String_Access;
Gcc : String;
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 the
+ -- gnatbind.
+
+ Size : Integer;
+ -- The number of bytes for the invocation of the gnatbind
+
Warning_For_Library : Boolean := False;
-- Set to True for the first warning about a unit missing from the
-- interface set.
- Libgnarl_Needed : Boolean := False;
+ Current_Proj : Project_Id;
+
+ Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed;
-- Set to True if library needs to be linked with libgnarl
Libdecgnat_Needed : Boolean := False;
-- On OpenVMS, set to True if library needs to be linked with libdecgnat
- Data : Project_Data := Projects.Table (For_Project);
+ Gtrasymobj_Needed : Boolean := False;
+ -- On OpenVMS, set to True if library needs to be linked with
+ -- g-trasym.obj.
Object_Directory_Path : constant String :=
- Get_Name_String (Data.Object_Directory);
+ Get_Name_String
+ (For_Project.Object_Directory.Display_Name);
- Standalone : constant Boolean := Data.Standalone_Library;
+ Standalone : constant Boolean := For_Project.Standalone_Library;
- Project_Name : constant String := Get_Name_String (Data.Name);
-
- DLL_Address : constant String_Access :=
- new String'(Default_DLL_Address);
+ Project_Name : constant String := Get_Name_String (For_Project.Name);
Current_Dir : constant String := Get_Current_Dir;
Library_Options : Variable_Value := Nil_Variable_Value;
- Library_GCC : 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
-- If null, Path Option is not supported.
-- Not a constant so that it can be deallocated.
- Copy_Dir : Name_Id;
- -- Directory where to copy ALI files and possibly interface sources
-
- First_ALI : Name_Id := No_Name;
+ 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 : Name_Id);
+ procedure Add_ALI_For (Source : File_Name_Type);
-- Add the name of the ALI file corresponding to Source to the
-- Arguments.
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);
+ 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).
+ -- case when there is a dependency on dec.ads), and set
+ -- Gtrasymobj_Needed if there is a dependency on g-trasym.ads.
procedure Process (The_ALI : File_Name_Type);
-- Check if the closure of a library unit which is or should be in the
-- Add_ALI_For --
-----------------
- procedure Add_ALI_For (Source : Name_Id) is
+ procedure Add_ALI_For (Source : File_Name_Type) is
ALI : constant String := ALI_File_Name (Get_Name_String (Source));
- ALI_Id : Name_Id;
+ ALI_Id : File_Name_Type;
begin
if Bind then
-- Set First_ALI, if not already done
- if First_ALI = No_Name then
+ if First_ALI = No_File then
First_ALI := ALI_Id;
end if;
end Add_ALI_For;
-- Start of processing for Add_Rpath
begin
- -- If firt path, allocate initial Rpath
+ -- If first path, allocate initial Rpath
if Rpath = null then
Rpath := new String (1 .. Initial_Rpath_Length);
elsif P /= No_Project then
declare
- Data : Project_Data := Projects.Table (For_Project);
+ Proj : Project_Id;
begin
- while Data.Extends /= No_Project loop
- if P = Data.Extends then
+ Proj := For_Project;
+ while Proj.Extends /= No_Project loop
+ if P = Proj.Extends then
return True;
end if;
- Data := Projects.Table (Data.Extends);
+ Proj := Proj.Extends;
end loop;
end;
end if;
-- Check_Libs --
----------------
- procedure Check_Libs (ALI_File : String) is
- Lib_File : Name_Id;
+ procedure Check_Libs (ALI_File : String; Main_Project : Boolean) is
+ Lib_File : File_Name_Type;
Text : Text_Buffer_Ptr;
Id : ALI.ALI_Id;
- pragma Warnings (Off, Id);
- -- Comment needed ???
-
begin
- if not Libgnarl_Needed or
- (Hostparm.OpenVMS and then (not Libdecgnat_Needed))
+ if Libgnarl_Needed /= Yes
+ or else
+ (Main_Project
+ and then OpenVMS_On_Target
+ and then ((not Libdecgnat_Needed) or (not Gtrasymobj_Needed)))
then
-- Scan the 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");
+ 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
ALI.ALIs.Table (Id).Last_Sdep
loop
if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
- Libgnarl_Needed := True;
+ Libgnarl_Needed := Yes;
- elsif Hostparm.OpenVMS and then
- ALI.Sdep.Table (Index).Sfile = S_Dec_Ads
- then
- Libdecgnat_Needed := True;
+ 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;
+
+ elsif ALI.Sdep.Table (Index).Sfile = G_Trasym_Ads then
+ Gtrasymobj_Needed := True;
+ end if;
end if;
end loop;
end if;
for W in Unit_Data.First_With .. Unit_Data.Last_With loop
Afile := Withs.Table (W).Afile;
- if Afile /= No_Name and then Library_ALIs.Get (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 (Data.Name);
+ Get_Name_String (Current_Proj.Name);
To_Mixed (Name_Buffer (1 .. Name_Len));
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Line ("""");
---------------------
procedure Process_Project (Project : Project_Id) is
- Data : constant Project_Data := Projects.Table (Project);
- Imported : Project_List := Data.Imported_Projects;
- Element : Project_Element;
+ Imported : Project_List;
begin
-- Nothing to do if process has already been processed
- if not Processed_Projects.Get (Data.Name) then
- Processed_Projects.Set (Data.Name, True);
+ 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.
- while Imported /= Empty_Project_List loop
- Element := Project_Lists.Table (Imported);
-
- if Element.Project /= No_Project then
- Process_Project (Element.Project);
+ Imported := Project.Imported_Projects;
+ while Imported /= null loop
+ if Imported.Project /= No_Project then
+ Process_Project (Imported.Project);
end if;
- Imported := Element.Next;
+ Imported := Imported.Next;
end loop;
-- If it is a library project, add it to Library_Projs
- if Project /= For_Project and then Data.Library then
+ if Project /= For_Project and then Project.Library then
Library_Projs.Increment_Last;
Library_Projs.Table (Library_Projs.Last) := Project;
- end if;
+ -- 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;
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.
+ -- 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 (Projects.Table (Current).Library_Dir);
+ Get_Name_String (Current.Library_Dir.Display_Name);
Opts.Increment_Last;
Opts.Table (Opts.Last) :=
new String'("-L" & Name_Buffer (1 .. Name_Len));
Opts.Increment_Last;
Opts.Table (Opts.Last) :=
- new String'
- ("-l" &
- Get_Name_String
- (Projects.Table (Current).Library_Name));
+ new String'("-l" & Get_Name_String (Current.Library_Name));
end loop;
end Process_Imported_Libraries;
-- Fail if project is not a library project
- if not Data.Library then
- Com.Fail ("project """, Project_Name, """ has no library");
+ 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_Name then
- Name_Len := 12;
- Name_Buffer (1 .. Name_Len) := "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_Name then
- Name_Len := 7;
- Name_Buffer (1 .. Name_Len) := "dec.ads";
+ if S_Dec_Ads = No_File then
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer ("dec.ads");
S_Dec_Ads := Name_Find;
end if;
+ if G_Trasym_Ads = No_File then
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer ("g-trasym.ads");
+ G_Trasym_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);
+ Com.Fail ("unable to locate " & Gnatbind);
end if;
if Gcc_Path = null then
- Com.Fail ("unable to locate ", Gcc);
+ Com.Fail ("unable to locate " & Gcc);
end if;
-- Allocate Arguments, if it is the first time we see a standalone
Arguments := new String_List (1 .. Initial_Argument_Max);
end if;
- -- Add "-n -o b~<lib>.adb (b$<lib>.adb on VMS) -L<lib>"
+ -- 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 Hostparm.OpenVMS then
- B_Start (B_Start'Last) := '$';
+ if OpenVMS_On_Target then
+ B_Start := new String'("b__");
end if;
Add_Argument
- (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
- Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
+ (B_Start.all
+ & Get_Name_String (For_Project.Library_Name) & ".adb");
+ Add_Argument ("-L" & Get_Name_String (For_Project.Library_Name));
+
+ 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,
+ -- 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 => Data.Decl.Packages);
+ In_Packages => For_Project.Decl.Packages,
+ In_Tree => In_Tree);
begin
if Binder_Package /= No_Package then
Value_Of
(Name => Name_Default_Switches,
In_Arrays =>
- Packages.Table
- (Binder_Package).Decl.Arrays);
+ In_Tree.Packages.Table
+ (Binder_Package).Decl.Arrays,
+ In_Tree => In_Tree);
Switches : Variable_Value := Nil_Variable_Value;
Switch : String_List_Id := Nil_String;
if Defaults /= No_Array_Element then
Switches :=
Value_Of
- (Index => Name_Ada, In_Array => Defaults);
+ (Index => Name_Ada,
+ Src_Index => 0,
+ In_Array => Defaults,
+ In_Tree => In_Tree);
if not Switches.Default then
Switch := Switches.Values;
while Switch /= Nil_String loop
Add_Argument
(Get_Name_String
- (String_Elements.Table (Switch).Value));
- Switch := String_Elements.Table (Switch).Next;
+ (In_Tree.String_Elements.Table
+ (Switch).Value));
+ Switch := In_Tree.String_Elements.
+ Table (Switch).Next;
end loop;
end if;
end if;
-- Bind is False, so that First_ALI is set.
declare
- Unit : Unit_Data;
+ Unit : Unit_Index;
begin
Library_ALIs.Reset;
Interface_ALIs.Reset;
Processed_ALIs.Reset;
- for Source in 1 .. Com.Units.Last loop
- Unit := Com.Units.Table (Source);
-
- if Unit.File_Names (Body_Part).Name /= No_Name
- and then Unit.File_Names (Body_Part).Path /= Slash
+ 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 (Body_Part).Project)
- then
- if Unit.File_Names (Specification).Name = No_Name then
+ if Check_Project (Unit.File_Names (Impl).Project) then
+ if Unit.File_Names (Spec) = null then
declare
Src_Ind : Source_File_Index;
begin
Src_Ind := Sinput.P.Load_Project_File
- (Get_Name_String
- (Unit.File_Names
- (Body_Part).Path));
+ (Get_Name_String
+ (Unit.File_Names (Impl).Path.Name));
-- Add the ALI file only if it is not a subunit
- if
- not Sinput.P.Source_File_Is_Subunit (Src_Ind)
+ if not
+ Sinput.P.Source_File_Is_Subunit (Src_Ind)
then
- Add_ALI_For
- (Unit.File_Names (Body_Part).Name);
+ Add_ALI_For (Unit.File_Names (Impl).File);
exit when not Bind;
end if;
end;
else
- Add_ALI_For (Unit.File_Names (Body_Part).Name);
+ Add_ALI_For (Unit.File_Names (Impl).File);
exit when not Bind;
end if;
end if;
- elsif Unit.File_Names (Specification).Name /= No_Name
- and then Unit.File_Names (Specification).Path /= Slash
- and then Check_Project
- (Unit.File_Names (Specification).Project)
+ 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 (Specification).Name);
+ 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;
-- Get an eventual --RTS from the ALI file
- if First_ALI /= No_Name then
+ if First_ALI /= No_File then
declare
- use Types;
T : Text_Buffer_Ptr;
A : ALI_Id;
ALI.Units.Table
(ALI.ALIs.Table (A).First_Unit).Last_Arg
loop
- -- Look for --RTS. If found, add the switch to call
- -- gnatbind.
+ -- If --RTS found, add switch to call gnatbind
declare
Arg : String_Ptr renames Args.Table (Index);
begin
- if
- Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
+ if Arg'Length >= 6 and then
+ Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
then
Add_Argument (Arg.all);
exit;
-- Set the paths
Set_Ada_Paths
- (Project => For_Project, Including_Libraries => True);
+ (Project => For_Project,
+ In_Tree => In_Tree,
+ Including_Libraries => True);
-- Display the gnatbind command, if not in quiet output
Display (Gnatbind);
- -- Invoke 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);
+
+ else
+ -- Otherwise create a temporary response file
+
+ 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
- GNAT.OS_Lib.Spawn
- (Gnatbind_Path.all, Arguments (1 .. Argument_Number), Success);
+ 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);
+
+ if not Succ then
+ null;
+ end if;
+ end;
+ end if;
if not Success then
- Com.Fail ("could not bind standalone library ",
- Get_Name_String (Data.Library_Name));
+ 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, Including_Libraries => True);
+ (Project => For_Project,
+ In_Tree => In_Tree,
+ Including_Libraries => True);
- -- Invoke <gcc> -c b$$<lib>.adb
+ -- Invoke <gcc> -c b__<lib>.adb
-- Allocate Arguments, if it is the first time we see a standalone
-- library.
Argument_Number := 1;
Arguments (1) := Compile_Switch;
- if Hostparm.OpenVMS then
- B_Start (B_Start'Last) := '$';
+ if OpenVMS_On_Target then
+ B_Start := new String'("b__");
end if;
Add_Argument
- (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
+ (B_Start.all
+ & Get_Name_String (For_Project.Library_Name) & ".adb");
-- If necessary, add the PIC option
-- Get the back-end switches and --RTS from the ALI file
- if First_ALI /= No_Name then
+ if First_ALI /= No_File then
declare
- use Types;
T : Text_Buffer_Ptr;
A : ALI_Id;
-- Read it
- A := Scan_ALI
- (First_ALI, T, Ignore_ED => False, Err => False);
+ A :=
+ Scan_ALI (First_ALI, T, Ignore_ED => False, Err => False);
if A /= No_ALI_Id then
for Index in
-- generated file.
Display (Gcc);
- GNAT.OS_Lib.Spawn
+ 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 (Data.Library_Name));
+ ("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
-- Build the library only if Link is True
if Link then
- -- If attribute Library_GCC was specified, get the driver name
- Library_GCC := Value_Of (Name_Library_GCC, Data.Decl.Attributes);
+ -- If attributes Library_GCC or Linker'Driver were specified, get the
+ -- driver name.
- if not Library_GCC.Default then
- Driver_Name := Library_GCC.Value;
+ 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 additional
-- options.
- Library_Options :=
- Value_Of (Name_Library_Options, Data.Decl.Attributes);
+ Library_Options := Value_Of
+ (Name_Library_Options, For_Project.Decl.Attributes, In_Tree);
if not Library_Options.Default then
declare
- Current : String_List_Id := Library_Options.Values;
+ Current : String_List_Id;
Element : String_Element;
begin
+ Current := Library_Options.Values;
while Current /= Nil_String loop
- Element := String_Elements.Table (Current);
+ Element := In_Tree.String_Elements.Table (Current);
Get_Name_String (Element.Value);
if Name_Len /= 0 then
end;
end if;
- Lib_Dirpath := new String'(Get_Name_String (Data.Library_Dir));
- Lib_Filename := new String'(Get_Name_String (Data.Library_Name));
+ 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 Data.Library_Kind is
+ case For_Project.Library_Kind is
when Static =>
The_Build_Mode := Static;
-- Get the library version, if any
- if Data.Lib_Internal_Name /= No_Name then
+ if For_Project.Lib_Internal_Name /= No_Name then
Lib_Version :=
- new String'(Get_Name_String (Data.Lib_Internal_Name));
+ 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.
+ -- 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;
- loop
- declare
- Object_Dir_Path : constant String :=
- Get_Name_String (Data.Object_Directory);
- 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);
+ -- 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.
- exit when Last = 0;
-
- -- Check if it is an object file
-
- if Is_Obj (Filename (1 .. Last)) then
- declare
- Object_Path : String :=
- Normalize_Pathname
- (Object_Dir_Path & Directory_Separator &
- Filename (1 .. Last));
-
- begin
- Canonical_Case_File_Name (Object_Path);
- Canonical_Case_File_Name (Filename (1 .. Last));
+ Foreign_Sources := For_Project.Languages.Next /= null;
+ Current_Proj := For_Project;
+ loop
+ if Current_Proj.Object_Directory /= No_Path_Information then
- -- If in the object directory of an extended project,
- -- do not consider generated object files.
+ -- The following code gets far too indented, I suggest some
+ -- procedural abstraction here. How about making this declare
+ -- block a named procedure???
- if In_Main_Object_Directory
- or else Last < 5
- or else Filename (1 .. B_Start'Length) /= B_Start
- then
- Name_Len := Last;
- Name_Buffer (1 .. Name_Len) := Filename (1 .. Last);
- Id := Name_Find;
+ declare
+ Object_Dir_Path : constant String :=
+ Get_Name_String
+ (Current_Proj.Object_Directory
+ .Display_Name);
- if not Objects_Htable.Get (Id) then
+ Object_Dir : Dir_Type;
+ Filename : String (1 .. 255);
+ Last : Natural;
+ Id : Name_Id;
- -- Record this object file
+ begin
+ Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path);
- Objects_Htable.Set (Id, True);
- Objects.Increment_Last;
- Objects.Table (Objects.Last) :=
- new String'(Object_Path);
+ -- For all entries in the object directory
- declare
- ALI_File : constant String :=
- Ext_To (Object_Path, "ali");
+ loop
+ Read (Object_Dir, Filename, Last);
- begin
- if Is_Regular_File (ALI_File) then
+ exit when Last = 0;
- -- Record the ALI file
+ -- Check if it is an object file
- ALIs.Increment_Last;
- ALIs.Table (ALIs.Last) :=
- new String'(ALI_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);
- -- Find out if for this ALI file,
- -- libgnarl or libdecgnat (on OpenVMS)
- -- is necessary.
+ C_Filename : String := Object_File;
- Check_Libs (ALI_File);
+ begin
+ Canonical_Case_File_Name (C_Filename);
- else
- -- Object file is a foreign object file
+ -- If in the object directory of an extended
+ -- project, do not consider generated object files.
- Foreigns.Increment_Last;
- Foreigns.Table (Foreigns.Last) :=
- new String'(Object_Path);
- end if;
- end;
+ 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 or
+ -- g-trasym.obj (on OpenVMS) 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 if;
- end;
- end if;
- end loop;
+ end;
+ end if;
+ end loop;
- Close (Dir => Object_Dir);
+ Close (Dir => Object_Dir);
- exception
- when Directory_Error =>
- Com.Fail ("cannot find object directory """,
- Get_Name_String (Data.Object_Directory),
- """");
- end;
+ exception
+ when Directory_Error =>
+ Com.Fail ("cannot find object directory """
+ & Get_Name_String
+ (Current_Proj.Object_Directory.Display_Name)
+ & """");
+ end;
+ end if;
- exit when Data.Extends = No_Project;
+ exit when Current_Proj.Extends = No_Project;
In_Main_Object_Directory := False;
- Data := Projects.Table (Data.Extends);
+ Current_Proj := Current_Proj.Extends;
end loop;
-- Add the -L and -l switches for the imported Library Project Files,
-- Rpath.
if Path_Option /= null then
- Add_Rpath (Lib_Directory);
+ 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 then
+ if Libgnarl_Needed = Yes then
Opts.Increment_Last;
if The_Build_Mode = Static then
end if;
end if;
+ if Gtrasymobj_Needed then
+ Opts.Increment_Last;
+ Opts.Table (Opts.Last) :=
+ new String'(Lib_Directory & "/g-trasym.obj");
+ end if;
+
if Libdecgnat_Needed then
Opts.Increment_Last;
+
Opts.Table (Opts.Last) :=
new String'("-L" & Lib_Directory & "/../declib");
+
Opts.Increment_Last;
- Opts.Table (Opts.Last) := new String'("-ldecgnat");
+
+ 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;
new Argument_List'
(Argument_List (Objects.Table (1 .. Objects.Last)));
- Foreign_Objects :=
- new Argument_List'(Argument_List
- (Foreigns.Table (1 .. Foreigns.Last)));
-
Ali_Files :=
new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
Write_Str (" library for project ");
Write_Line (Project_Name);
- Write_Eol;
+ -- Only output list of object files and ALI files in verbose mode
- Write_Line ("object files:");
+ if Opt.Verbose_Mode then
+ Write_Eol;
- for Index in Object_Files'Range loop
- Write_Str (" ");
- Write_Line (Object_Files (Index).all);
- end loop;
+ Write_Line ("object files:");
- Write_Eol;
+ for Index in Object_Files'Range loop
+ Write_Str (" ");
+ Write_Line (Object_Files (Index).all);
+ end loop;
- if Ali_Files'Length = 0 then
- Write_Line ("NO ALI files");
+ Write_Eol;
- else
- Write_Line ("ALI files:");
+ if Ali_Files'Length = 0 then
+ Write_Line ("NO ALI files");
- for Index in Ali_Files'Range loop
- Write_Str (" ");
- Write_Line (Ali_Files (Index).all);
- end loop;
- end if;
+ else
+ Write_Line ("ALI files:");
- Write_Eol;
+ 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.
+ -- 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 & "/lib" &
+ Lib_Dirpath.all & Directory_Separator & DLL_Prefix &
Lib_Filename.all & "." & DLL_Ext;
Archive_Name : aliased String :=
- Lib_Dirpath.all & "/lib" &
+ Lib_Dirpath.all & Directory_Separator & "lib" &
Lib_Filename.all & "." & Archive_Ext;
type Str_Ptr is access all String;
-- Designates the full library path name. Either DLL_Name or
-- Archive_Name, depending on the library kind.
- Success : Boolean := False;
+ Success : Boolean;
+ pragma Warnings (Off, Success);
-- Used to call Delete_File
begin
-- the library directory (by Copy_ALI_Files, below).
if Standalone then
- Data := Projects.Table (For_Project);
+ Current_Proj := For_Project;
declare
- Interface : String_List_Id := Data.Lib_Interface_ALIs;
- ALI : File_Name_Type;
+ Iface : String_List_Id := For_Project.Lib_Interface_ALIs;
+ ALI : File_Name_Type;
begin
- while Interface /= Nil_String loop
- ALI := String_Elements.Table (Interface).Value;
+ while Iface /= Nil_String loop
+ ALI :=
+ File_Name_Type
+ (In_Tree.String_Elements.Table (Iface).Value);
Interface_ALIs.Set (ALI, True);
- Get_Name_String (String_Elements.Table (Interface).Value);
+ Get_Name_String
+ (In_Tree.String_Elements.Table (Iface).Value);
Add_Argument (Name_Buffer (1 .. Name_Len));
- Interface := String_Elements.Table (Interface).Next;
+ Iface := In_Tree.String_Elements.Table (Iface).Next;
end loop;
- Interface := Data.Lib_Interface_ALIs;
+ Iface := For_Project.Lib_Interface_ALIs;
if not Opt.Quiet_Output then
-- library that is needed by an interface should also be an
-- interface. If it is not the case, output a warning.
- while Interface /= Nil_String loop
- ALI := String_Elements.Table (Interface).Value;
+ while Iface /= Nil_String loop
+ ALI :=
+ File_Name_Type
+ (In_Tree.String_Elements.Table (Iface).Value);
Process (ALI);
- Interface := String_Elements.Table (Interface).Next;
+ Iface := In_Tree.String_Elements.Table (Iface).Next;
end loop;
end if;
end;
end if;
- -- Clean the library directory, if it is also the directory where
- -- the ALI files are copied, either because there is no interface
- -- copy directory or because the interface copy directory is the
- -- same as the library directory.
+ 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);
- Copy_Dir := Projects.Table (For_Project).Library_Dir;
- Clean (Copy_Dir);
+ Change_Dir (Current_Dir);
+ end;
-- Call procedure to build the library, depending on the build mode
when Dynamic | Relocatable =>
Build_Dynamic_Library
(Ofiles => Object_Files.all,
- Foreign => Foreign_Objects.all,
- Afiles => Ali_Files.all,
Options => Options.all,
Interfaces => Arguments (1 .. Argument_Number),
Lib_Filename => Lib_Filename.all,
Lib_Dir => Lib_Dirpath.all,
- Symbol_Data => Data.Symbol_Data,
+ Symbol_Data => Current_Proj.Symbol_Data,
Driver_Name => Driver_Name,
- Lib_Address => DLL_Address.all,
Lib_Version => Lib_Version.all,
- Relocatable => The_Build_Mode = Relocatable,
- Auto_Init => Data.Lib_Auto_Init);
+ Auto_Init => Current_Proj.Lib_Auto_Init);
when Static =>
MLib.Build_Library
(Object_Files.all,
- Ali_Files.all,
Lib_Filename.all,
Lib_Dirpath.all);
null;
end case;
- -- We need to copy the ALI files from the object directory to
- -- the library 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.
+ -- 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 => Copy_Dir,
+ 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 Projects.Table (For_Project).Library_Src_Dir /= No_Name
+ and then For_Project.Library_Src_Dir /= No_Path_Information
then
- -- Clean the interface copy directory, if it is not also the
- -- library directory. If it is also the library directory, it
- -- has already been cleaned before generation of the library.
+ -- Clean the interface copy directory: remove any source that
+ -- could be a source of the project.
- if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then
- Copy_Dir := Projects.Table (For_Project).Library_Src_Dir;
- Clean (Copy_Dir);
- end if;
+ 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,
- Interfaces => Arguments (1 .. Argument_Number),
- To_Dir => Copy_Dir);
+ In_Tree => In_Tree,
+ Interfaces => Arguments (1 .. Argument_Number),
+ To_Dir => For_Project.Library_Src_Dir.Display_Name);
end if;
end if;
procedure Check (Filename : String) is
begin
if not Is_Regular_File (Filename) then
- Com.Fail (Filename, " not found.");
+ Com.Fail (Filename & " not found.");
end if;
end Check;
-- Check_Library --
-------------------
- procedure Check_Library (For_Project : Project_Id) is
- Data : constant Project_Data := Projects.Table (For_Project);
+ 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
- if Data.Library and not Data.Flag1 then
- declare
- Current : constant Dir_Name_Str := Get_Current_Dir;
- Lib_Name : constant Name_Id := Library_File_Name_For (For_Project);
- Lib_TS : Time_Stamp_Type;
- Obj_TS : Time_Stamp_Type;
-
- Object_Dir : Dir_Type;
+ -- 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
- if Hostparm.OpenVMS then
- B_Start (B_Start'Last) := '$';
- end if;
-
- Change_Dir (Get_Name_String (Data.Library_Dir));
-
+ 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 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 (Data.Object_Directory));
- 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
- then
- -- Get the object file time stamp
-
- Obj_TS := File_Stamp (Name_Find);
-
- -- If library file time stamp is earlier, set Flag1 and
- -- return. String comparaison is used, otherwise time stamps
- -- may be too close and the comparaison would return True,
- -- which would trigger an unnecessary rebuild of the
- -- library.
-
- if String (Lib_TS) < String (Obj_TS) then
-
- -- Library must be rebuilt
+ 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;
- Projects.Table (For_Project).Flag1 := True;
- exit;
- end if;
+ begin
+ if OpenVMS_On_Target then
+ B_Start := new String'("b__");
end if;
- end loop;
-
- Change_Dir (Current);
- end;
- end if;
- end Check_Library;
-
- -----------
- -- Clean --
- -----------
- procedure Clean (Directory : Name_Id) is
- Current : constant Dir_Name_Str := Get_Current_Dir;
+ -- If the library file does not exist, then the time stamp will
+ -- be Empty_Time_Stamp, earlier than any other time stamp.
- Dir : Dir_Type;
+ Change_Dir
+ (Get_Name_String (For_Project.Object_Directory.Display_Name));
+ Open (Dir => Object_Dir, Dir_Name => ".");
- Name : String (1 .. 200);
- Last : Natural;
+ -- For all entries in the object directory
- Disregard : Boolean;
+ loop
+ Read (Object_Dir, Name_Buffer, Name_Len);
+ exit when Name_Len = 0;
- procedure Set_Writable (Name : System.Address);
- pragma Import (C, Set_Writable, "__gnat_set_writable");
+ -- Check if it is an object file, but ignore any binder
+ -- generated file.
- begin
- Get_Name_String (Directory);
+ 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
- -- Change the working directory to the directory to clean
+ Obj_TS := File_Stamp (File_Name_Type'(Name_Find));
- begin
- Change_Dir (Name_Buffer (1 .. Name_Len));
+ -- 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.
- exception
- when others =>
- Com.Fail
- ("unable to access directory """,
- Name_Buffer (1 .. Name_Len),
- """");
- end;
+ if String (Lib_TS) < String (Obj_TS) then
- Open (Dir, ".");
+ -- Library must be rebuilt
- -- For each regular file in the directory, make it writable and
- -- delete the file.
-
- loop
- Read (Dir, Name, Last);
- exit when Last = 0;
+ For_Project.Need_To_Build_Lib := True;
+ exit;
+ end if;
+ end if;
+ end loop;
- if Is_Regular_File (Name (1 .. Last)) then
- Name (Last + 1) := ASCII.NUL;
- Set_Writable (Name (1)'Address);
- Delete_File (Name (1 .. Last), Disregard);
+ Close (Object_Dir);
+ end;
end if;
- end loop;
-
- Close (Dir);
-
- -- Restore the initial working directory
- Change_Dir (Current);
- end Clean;
+ 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 : Name_Id)
+ To_Dir : Path_Name_Type)
is
- Current : constant Dir_Name_Str := Get_Current_Dir;
- Target : constant Dir_Name_Str := Get_Name_String (To_Dir);
+ 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 : Name_Id;
+ Lib_File : File_Name_Type;
First_Unit : ALI.Unit_Id;
Second_Unit : ALI.Unit_Id;
- Data : Unit_Data;
-
Copy_Subunits : Boolean := False;
+ -- When True, indicates that subunits, if any, need to be copied too
- procedure Copy (File_Name : Name_Id);
+ procedure Copy (File_Name : File_Name_Type);
-- Copy one source of the project to the target directory
----------
-- Copy --
----------
- procedure Copy (File_Name : Name_Id) is
- Success : Boolean := False;
+ procedure Copy (File_Name : File_Name_Type) is
+ Success : Boolean;
+ pragma Warnings (Off, Success);
+ Source : Standard.Prj.Source_Id;
begin
- Unit_Loop :
- for Index in 1 .. Com.Units.Last loop
- Data := Com.Units.Table (Index);
-
- for J in Data.File_Names'Range loop
- if Data.File_Names (J).Project = For_Project
- and then Data.File_Names (J).Name = File_Name
- then
- Copy_File
- (Get_Name_String (Data.File_Names (J).Path),
- Target,
- Success,
- Mode => Overwrite,
- Preserve => Preserve);
- exit Unit_Loop;
- end if;
- end loop;
- end loop Unit_Loop;
+ 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;
- use ALI;
-
-- Start of processing for Copy_Interface_Sources
begin
-- Change the working directory to the object directory
- Change_Dir
- (Get_Name_String (Projects.Table (For_Project).Object_Directory));
+ Change_Dir (Get_Name_String (For_Project.Object_Directory.Display_Name));
for Index in Interfaces'Range loop
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 --
-------------------------
Fd : FILEs;
-- Binder file's descriptor
- Read_Mode : constant String := "r" & ASCII.Nul;
+ Read_Mode : constant String := "r" & ASCII.NUL;
-- For fopen
Status : Interfaces.C_Streams.int;
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
end if;
Status := fclose (Fd);
+
-- Is it really right to ignore any close error ???
+
end Process_Binder_File;
------------------
begin
Objects.Init;
Objects_Htable.Reset;
- Foreigns.Init;
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;
OSDN Git Service
