-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2010, AdaCore --
+-- Copyright (C) 2001-2011, 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- --
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;
S_Dec_Ads : File_Name_Type := No_File;
-- Name_Id for "dec.ads"
- 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
- -- the compiler. Also used to collect the interface ALI when copying
- -- the ALI files to the library directory.
+ -- 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;
- 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;
- 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;
- 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";
is
Maximum_Size : Integer;
pragma Import (C, Maximum_Size, "__gnat_link_max");
- -- Maximum number of bytes to put in an invocation of the
- -- gnatbind.
+ -- Maximum number of bytes to put in an invocation of gnatbind
Size : Integer;
- -- The number of bytes for the invocation of the gnatbind
+ -- The number of bytes for the invocation of gnatbind
Warning_For_Library : Boolean := False;
- -- Set to True for the first warning about a unit missing from the
- -- interface set.
+ -- 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 to True if library needs to be linked with libgnarl
+ -- Set 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
-
- Gtrasymobj_Needed : Boolean := False;
- -- On OpenVMS, set to True if library needs to be linked with
- -- g-trasym.obj.
+ -- On OpenVMS, set True if library needs to be linked with libdecgnat
Object_Directory_Path : constant String :=
Get_Name_String
-- 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.
+ -- 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 the name of the ALI file corresponding to Source to the
- -- Arguments.
+ -- Add name of the ALI file corresponding to Source to the Arguments
procedure Add_Rpath (Path : String);
-- Add a path name to Rpath
-- 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), and set
- -- Gtrasymobj_Needed if there is a dependency on g-trasym.ads.
+ -- 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
if Libgnarl_Needed /= Yes
or else
(Main_Project
- and then OpenVMS_On_Target
- and then ((not Libdecgnat_Needed) or (not Gtrasymobj_Needed)))
+ and then OpenVMS_On_Target)
then
-- Scan the ALI file
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 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
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);
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;
Add_Argument
(B_Start.all
& Get_Name_String (For_Project.Library_Name) & ".adb");
- Add_Argument ("-L" & Get_Name_String (For_Project.Library_Name));
+
+ -- 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);
Value_Of
(Name => Name_Binder,
In_Packages => For_Project.Decl.Packages,
- In_Tree => In_Tree);
+ Shared => In_Tree.Shared);
begin
if Binder_Package /= No_Package then
Value_Of
(Name => Name_Default_Switches,
In_Arrays =>
- In_Tree.Packages.Table
+ In_Tree.Shared.Packages.Table
(Binder_Package).Decl.Arrays,
- In_Tree => In_Tree);
- Switches : Variable_Value := Nil_Variable_Value;
+ Shared => In_Tree.Shared);
- Switch : String_List_Id := Nil_String;
+ Switches : Variable_Value := Nil_Variable_Value;
+ Switch : String_List_Id := Nil_String;
begin
if Defaults /= No_Array_Element then
(Index => Name_Ada,
Src_Index => 0,
In_Array => Defaults,
- In_Tree => In_Tree);
+ Shared => In_Tree.Shared);
if not Switches.Default then
Switch := Switches.Values;
while Switch /= Nil_String loop
Add_Argument
(Get_Name_String
- (In_Tree.String_Elements.Table
+ (In_Tree.Shared.String_Elements.Table
(Switch).Value));
- Switch := In_Tree.String_Elements.
+ Switch := In_Tree.Shared.String_Elements.
Table (Switch).Next;
end loop;
end if;
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 (Impl).Path.Name));
-
- -- Add the ALI file only if it is not a subunit
+ -- 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
-- Set the paths
- Set_Ada_Paths
- (Project => For_Project,
- In_Tree => In_Tree,
- Including_Libraries => True);
+ -- 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
Arguments (1 .. Argument_Number),
Success);
- else
- -- Otherwise create a temporary response file
+ -- Otherwise create a temporary response file
+ else
declare
FD : File_Descriptor;
Path : Path_Name_Type;
-- Invoke <gcc> -c b__<lib>.adb
- -- Allocate Arguments, if it is the first time we see a standalone
- -- library.
+ -- 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 := 1;
+ Argument_Number := 2;
Arguments (1) := Compile_Switch;
+ Arguments (2) := No_Warning;
if OpenVMS_On_Target then
B_Start := new String'("b__");
end;
end if;
- -- Now that all the arguments are set, compile the binder
- -- generated file.
+ -- Now all the arguments are set, compile binder generated file
Display (Gcc);
Spawn
-- Process binder generated file for pragmas Linker_Options
- Process_Binder_File (Arguments (2).all & ASCII.NUL);
+ Process_Binder_File (Arguments (3).all & ASCII.NUL);
end if;
end if;
Driver_Name := Name_Id (For_Project.Config.Shared_Lib_Driver);
end if;
- -- If attribute Library_Options was specified, add these additional
- -- options.
+ -- If attribute Library_Options was specified, add these options
Library_Options := Value_Of
- (Name_Library_Options, For_Project.Decl.Attributes, In_Tree);
+ (Name_Library_Options, For_Project.Decl.Attributes,
+ In_Tree.Shared);
if not Library_Options.Default then
declare
begin
Current := Library_Options.Values;
while Current /= Nil_String loop
- Element := In_Tree.String_Elements.Table (Current);
+ Element := In_Tree.Shared.String_Elements.Table (Current);
Get_Name_String (Element.Value);
if Name_Len /= 0 then
Lib_Dirpath :=
new String'(Get_Name_String (For_Project.Library_Dir.Display_Name));
- Lib_Filename := new String'
- (Get_Name_String (For_Project.Library_Name));
+ Lib_Filename :=
+ new String'(Get_Name_String (For_Project.Library_Name));
case For_Project.Library_Kind is
when Static =>
loop
if Current_Proj.Object_Directory /= No_Path_Information then
- -- The following code gets far too indented, I suggest some
+ -- The following code gets far too indented ... suggest some
-- procedural abstraction here. How about making this declare
-- block a named procedure???
(Object_Dir_Path
& Directory_Separator
& Filename (1 .. Last));
+ Object_File : constant String :=
+ Filename (1 .. Last);
- C_Object_Path : String := Object_Path;
- C_Filename : String := Filename (1 .. Last);
+ C_Filename : String := Object_File;
begin
- Canonical_Case_File_Name (C_Object_Path);
Canonical_Case_File_Name (C_Filename);
-- If in the object directory of an extended
or else
C_Filename (1 .. B_Start'Length) /= B_Start.all
then
- Name_Len := Last;
- Name_Buffer (1 .. Name_Len) :=
- C_Filename (1 .. Last);
+ 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
- (1 .. Last), "ali");
+ Ext_To (C_Filename, "ali");
ALI_Path : constant String :=
- Ext_To (C_Object_Path, "ali");
+ Ext_To (Object_Path, "ali");
Add_It : Boolean;
Fname : File_Name_Type;
ALIs.Append (new String'(ALI_Path));
-- Find out if for this ALI file,
- -- libgnarl or libdecgnat or
- -- g-trasym.obj (on OpenVMS) is
+ -- libgnarl or libdecgnat is
-- necessary.
Check_Libs (ALI_Path, True);
Opts.Increment_Last;
Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory);
- -- If Path Option is supported, add libgnat directory path name to
- -- Rpath.
+ -- If Path Option supported, add libgnat directory path name to Rpath
if Path_Option /= null then
declare
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;
while Iface /= Nil_String loop
ALI :=
File_Name_Type
- (In_Tree.String_Elements.Table (Iface).Value);
+ (In_Tree.Shared.String_Elements.Table (Iface).Value);
Interface_ALIs.Set (ALI, True);
Get_Name_String
- (In_Tree.String_Elements.Table (Iface).Value);
+ (In_Tree.Shared.String_Elements.Table (Iface).Value);
Add_Argument (Name_Buffer (1 .. Name_Len));
- Iface := In_Tree.String_Elements.Table (Iface).Next;
+ Iface := In_Tree.Shared.String_Elements.Table (Iface).Next;
end loop;
Iface := For_Project.Lib_Interface_ALIs;
while Iface /= Nil_String loop
ALI :=
File_Name_Type
- (In_Tree.String_Elements.Table (Iface).Value);
+ (In_Tree.Shared.String_Elements.Table (Iface).Value);
Process (ALI);
- Iface := In_Tree.String_Elements.Table (Iface).Next;
+ Iface :=
+ In_Tree.Shared.String_Elements.Table (Iface).Next;
end loop;
end if;
end;
-- the library file and any ALI file of a source of the project.
begin
- Get_Name_String (For_Project.Library_Dir.Name);
+ Get_Name_String (For_Project.Library_Dir.Display_Name);
Change_Dir (Name_Buffer (1 .. Name_Len));
exception
Copy_ALI_Files
(Files => Ali_Files.all,
- To => For_Project.Library_ALI_Dir.Name,
+ To => For_Project.Library_ALI_Dir.Display_Name,
Interfaces => Arguments (1 .. Argument_Number));
-- Copy interface sources if Library_Src_Dir specified
-- could be a source of the project.
begin
- Get_Name_String (For_Project.Library_Src_Dir.Name);
+ Get_Name_String (For_Project.Library_Src_Dir.Display_Name);
Change_Dir (Name_Buffer (1 .. Name_Len));
exception
Lib_Name : constant File_Name_Type :=
Library_File_Name_For (For_Project, In_Tree);
begin
- Change_Dir (Get_Name_String (For_Project.Library_Dir.Name));
+ Change_Dir
+ (Get_Name_String (For_Project.Library_Dir.Display_Name));
Lib_TS := File_Stamp (Lib_Name);
For_Project.Library_TS := Lib_TS;
end;
-- be Empty_Time_Stamp, earlier than any other time stamp.
Change_Dir
- (Get_Name_String (For_Project.Object_Directory.Name));
+ (Get_Name_String (For_Project.Object_Directory.Display_Name));
Open (Dir => Object_Dir, Dir_Name => ".");
-- For all entries in the object directory
begin
-- Change the working directory to the object directory
- Change_Dir (Get_Name_String (For_Project.Object_Directory.Name));
+ Change_Dir (Get_Name_String (For_Project.Object_Directory.Display_Name));
for Index in Interfaces'Range loop
OSDN Git Service
