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 Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
with Switch; use Switch;
with Table;
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;
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;
ALI_Suffix : constant String := ".ali";
B_Start : String := "b~";
S_Osinte_Ads : Name_Id := No_Name;
S_Dec_Ads : Name_Id := No_Name;
G_Trasym_Ads : Name_Id := No_Name;
No_Argument_List : aliased String_List := (1 .. 0 => null);
No_Argument : constant String_List_Access := No_Argument_List'Access;
Arguments : String_List_Access := No_Argument;
Argument_Number : Natural := 0;
Initial_Argument_Max : constant := 10;
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;
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 => "=");
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);
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);
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);
package Library_ALIs is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Name_Id,
Hash => Hash,
Equal => "=");
package Interface_ALIs is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Name_Id,
Hash => Hash,
Equal => "=");
package Processed_ALIs is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Name_Id,
Hash => Hash,
Equal => "=");
package Processed_Projects is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Name_Id,
Hash => Hash,
Equal => "=");
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);
function ALI_File_Name (Source : String) return String;
procedure Check (Filename : String);
procedure Check_Context;
procedure Clean (Directory : Name_Id);
procedure Copy_Interface_Sources
(For_Project : Project_Id;
Interfaces : Argument_List;
To_Dir : Name_Id);
procedure Display (Executable : String);
procedure Process_Binder_File (Name : String);
procedure Reset_Tables;
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
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;
function ALI_File_Name (Source : String) return String is
begin
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;
return Source & ALI_Suffix;
end ALI_File_Name;
procedure Build_Library
(For_Project : Project_Id;
Gnatbind : String;
Gnatbind_Path : String_Access;
Gcc : String;
Gcc_Path : String_Access;
Bind : Boolean := True;
Link : Boolean := True)
is
Warning_For_Library : Boolean := False;
Libgnarl_Needed : Boolean := False;
Libdecgnat_Needed : Boolean := False;
Gtrasymobj_Needed : Boolean := False;
Data : Project_Data := Projects.Table (For_Project);
Object_Directory_Path : constant String :=
Get_Name_String (Data.Object_Directory);
Standalone : constant Boolean := Data.Standalone_Library;
Project_Name : constant String := Get_Name_String (Data.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;
Library_GCC : Variable_Value := Nil_Variable_Value;
Driver_Name : Name_Id := No_Name;
In_Main_Object_Directory : Boolean := True;
Rpath : String_Access := null;
Rpath_Last : Natural := 0;
Initial_Rpath_Length : constant := 200;
Path_Option : String_Access := Linker_Library_Path_Option;
Copy_Dir : Name_Id;
First_ALI : Name_Id := No_Name;
procedure Add_ALI_For (Source : Name_Id);
procedure Add_Rpath (Path : String);
function Check_Project (P : Project_Id) return Boolean;
procedure Check_Libs (ALI_File : String);
procedure Process (The_ALI : File_Name_Type);
procedure Process_Imported_Libraries;
procedure Add_ALI_For (Source : Name_Id) is
ALI : constant String := ALI_File_Name (Get_Name_String (Source));
ALI_Id : Name_Id;
begin
if Bind then
Add_Argument (ALI);
end if;
Name_Len := 0;
Add_Str_To_Name_Buffer (S => ALI);
ALI_Id := Name_Find;
if Bind then
Library_ALIs.Set (ALI_Id, True);
end if;
if First_ALI = No_Name then
First_ALI := ALI_Id;
end if;
end Add_ALI_For;
procedure Add_Rpath (Path : String) is
procedure 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;
begin
if Rpath = null then
Rpath := new String (1 .. Initial_Rpath_Length);
Rpath_Last := 0;
else
if Rpath_Last = Rpath'Last then
Double;
end if;
Rpath_Last := Rpath_Last + 1;
Rpath (Rpath_Last) := Path_Separator;
end if;
while Rpath_Last + Path'Length > Rpath'Last loop
Double;
end loop;
Rpath (Rpath_Last + 1 .. Rpath_Last + Path'Length) := Path;
Rpath_Last := Rpath_Last + Path'Length;
end Add_Rpath;
function Check_Project (P : Project_Id) return Boolean is
begin
if P = For_Project then
return True;
elsif P /= No_Project then
declare
Data : Project_Data := Projects.Table (For_Project);
begin
while Data.Extends /= No_Project loop
if P = Data.Extends then
return True;
end if;
Data := Projects.Table (Data.Extends);
end loop;
end;
end if;
return False;
end Check_Project;
procedure Check_Libs (ALI_File : String) is
Lib_File : Name_Id;
Text : Text_Buffer_Ptr;
Id : ALI.ALI_Id;
begin
if not Libgnarl_Needed or
(Hostparm.OpenVMS and then
((not Libdecgnat_Needed) or
(not Gtrasymobj_Needed)))
then
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);
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 := True;
elsif Hostparm.OpenVMS 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;
end Check_Libs;
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
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;
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);
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)
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);
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;
Process (Afile);
end if;
end loop;
end loop;
end if;
end if;
end if;
end Process;
procedure Process_Imported_Libraries is
Current : Project_Id;
procedure Process_Project (Project : Project_Id);
procedure Process_Project (Project : Project_Id) is
Data : constant Project_Data := Projects.Table (Project);
Imported : Project_List := Data.Imported_Projects;
Element : Project_Element;
begin
if not Processed_Projects.Get (Data.Name) then
Processed_Projects.Set (Data.Name, True);
while Imported /= Empty_Project_List loop
Element := Project_Lists.Table (Imported);
if Element.Project /= No_Project then
Process_Project (Element.Project);
end if;
Imported := Element.Next;
end loop;
if Project /= For_Project and then Data.Library then
Library_Projs.Increment_Last;
Library_Projs.Table (Library_Projs.Last) := Project;
end if;
end if;
end Process_Project;
begin
Process_Project (For_Project);
for Index in reverse 1 .. Library_Projs.Last loop
Current := Library_Projs.Table (Index);
Get_Name_String (Projects.Table (Current).Library_Dir);
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
(Projects.Table (Current).Library_Name));
end loop;
end Process_Imported_Libraries;
begin
Reset_Tables;
if not Data.Library then
Com.Fail ("project """, Project_Name, """ has no library");
end if;
if S_Osinte_Ads = No_Name 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 := 0;
Add_Str_To_Name_Buffer ("dec.ads");
S_Dec_Ads := Name_Find;
end if;
if G_Trasym_Ads = No_Name then
Name_Len := 0;
Add_Str_To_Name_Buffer ("g-trasym.ads");
G_Trasym_Ads := Name_Find;
end if;
Change_Dir (Object_Directory_Path);
if Standalone then
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;
if Arguments = No_Argument then
Arguments := new String_List (1 .. Initial_Argument_Max);
end if;
Argument_Number := 2;
Arguments (1) := No_Main;
Arguments (2) := Output_Switch;
if Hostparm.OpenVMS then
B_Start (B_Start'Last) := '$';
end if;
Add_Argument
(B_Start & Get_Name_String (Data.Library_Name) & ".adb");
Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
declare
Binder_Package : constant Package_Id :=
Value_Of
(Name => Name_Binder,
In_Packages => Data.Decl.Packages);
begin
if Binder_Package /= No_Package then
declare
Defaults : constant Array_Element_Id :=
Value_Of
(Name => Name_Default_Switches,
In_Arrays =>
Packages.Table
(Binder_Package).Decl.Arrays);
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);
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;
end loop;
end if;
end if;
end;
end if;
end;
end if;
declare
Unit : Unit_Data;
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
then
if
Check_Project (Unit.File_Names (Body_Part).Project)
then
if Unit.File_Names (Specification).Name = No_Name then
declare
Src_Ind : Source_File_Index;
begin
Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String
(Unit.File_Names
(Body_Part).Path));
if
not Sinput.P.Source_File_Is_Subunit (Src_Ind)
then
Add_ALI_For
(Unit.File_Names (Body_Part).Name);
exit when not Bind;
end if;
end;
else
Add_ALI_For (Unit.File_Names (Body_Part).Name);
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)
then
Add_ALI_For (Unit.File_Names (Specification).Name);
exit when not Bind;
end if;
end loop;
end;
if Bind then
if First_ALI /= No_Name then
declare
use Types;
T : Text_Buffer_Ptr;
A : ALI_Id;
begin
T := Read_Library_Info (First_ALI, True);
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
declare
Arg : String_Ptr renames Args.Table (Index);
begin
if
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_Ada_Paths
(Project => For_Project, Including_Libraries => True);
Display (Gnatbind);
GNAT.OS_Lib.Spawn
(Gnatbind_Path.all, Arguments (1 .. Argument_Number), Success);
if not Success then
Com.Fail ("could not bind standalone library ",
Get_Name_String (Data.Library_Name));
end if;
end if;
if Link then
Set_Ada_Paths
(Project => For_Project, Including_Libraries => True);
if Arguments = No_Argument then
Arguments := new String_List (1 .. Initial_Argument_Max);
end if;
Argument_Number := 1;
Arguments (1) := Compile_Switch;
if Hostparm.OpenVMS then
B_Start (B_Start'Last) := '$';
end if;
Add_Argument
(B_Start & Get_Name_String (Data.Library_Name) & ".adb");
if PIC_Option /= "" then
Add_Argument (PIC_Option);
end if;
if First_ALI /= No_Name then
declare
use Types;
T : Text_Buffer_Ptr;
A : ALI_Id;
begin
T := Read_Library_Info (First_ALI, True);
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
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;
Display (Gcc);
GNAT.OS_Lib.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));
end if;
Process_Binder_File (Arguments (2).all & ASCII.NUL);
end if;
end if;
if Link then
Library_GCC := Value_Of (Name_Library_GCC, Data.Decl.Attributes);
if not Library_GCC.Default then
Driver_Name := Library_GCC.Value;
end if;
Library_Options :=
Value_Of (Name_Library_Options, Data.Decl.Attributes);
if not Library_Options.Default then
declare
Current : String_List_Id := Library_Options.Values;
Element : String_Element;
begin
while Current /= Nil_String loop
Element := 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 (Data.Library_Dir));
Lib_Filename := new String'(Get_Name_String (Data.Library_Name));
case Data.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;
if Data.Lib_Internal_Name /= No_Name then
Lib_Version :=
new String'(Get_Name_String (Data.Lib_Internal_Name));
end if;
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);
loop
Read (Object_Dir, Filename, Last);
exit when Last = 0;
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));
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;
if not Objects_Htable.Get (Id) then
Objects_Htable.Set (Id, True);
Objects.Increment_Last;
Objects.Table (Objects.Last) :=
new String'(Object_Path);
declare
ALI_File : constant String :=
Ext_To (Object_Path, "ali");
begin
if Is_Regular_File (ALI_File) then
ALIs.Increment_Last;
ALIs.Table (ALIs.Last) :=
new String'(ALI_File);
Check_Libs (ALI_File);
else
Foreigns.Increment_Last;
Foreigns.Table (Foreigns.Last) :=
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 (Data.Object_Directory),
"""");
end;
exit when Data.Extends = No_Project;
In_Main_Object_Directory := False;
Data := Projects.Table (Data.Extends);
end loop;
Process_Imported_Libraries;
Opts.Increment_Last;
Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory);
if Path_Option /= null then
Add_Rpath (Lib_Directory);
end if;
if Libgnarl_Needed 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 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");
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 /= 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)));
Foreign_Objects :=
new Argument_List'(Argument_List
(Foreigns.Table (1 .. Foreigns.Last)));
Ali_Files :=
new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
Options :=
new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
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);
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;
Check_Context;
declare
DLL_Name : aliased String :=
Lib_Dirpath.all & "/lib" &
Lib_Filename.all & "." & DLL_Ext;
Archive_Name : aliased String :=
Lib_Dirpath.all & "/lib" &
Lib_Filename.all & "." & Archive_Ext;
type Str_Ptr is access all String;
Full_Lib_Name : Str_Ptr;
Success : Boolean := False;
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 Standalone then
Data := Projects.Table (For_Project);
declare
Iface : String_List_Id := Data.Lib_Interface_ALIs;
ALI : File_Name_Type;
begin
while Iface /= Nil_String loop
ALI := String_Elements.Table (Iface).Value;
Interface_ALIs.Set (ALI, True);
Get_Name_String (String_Elements.Table (Iface).Value);
Add_Argument (Name_Buffer (1 .. Name_Len));
Iface := String_Elements.Table (Iface).Next;
end loop;
Iface := Data.Lib_Interface_ALIs;
if not Opt.Quiet_Output then
while Iface /= Nil_String loop
ALI := String_Elements.Table (Iface).Value;
Process (ALI);
Iface := String_Elements.Table (Iface).Next;
end loop;
end if;
end;
end if;
Copy_Dir := Projects.Table (For_Project).Library_Dir;
Clean (Copy_Dir);
case The_Build_Mode is
when Dynamic | Relocatable =>
Build_Dynamic_Library
(Ofiles => Object_Files.all,
Foreign => Foreign_Objects.all,
Afiles => Ali_Files.all,
Options => Options.all,
Options_2 => No_Argument_List,
Interfaces => Arguments (1 .. Argument_Number),
Lib_Filename => Lib_Filename.all,
Lib_Dir => Lib_Dirpath.all,
Symbol_Data => Data.Symbol_Data,
Driver_Name => Driver_Name,
Lib_Version => Lib_Version.all,
Auto_Init => Data.Lib_Auto_Init);
when Static =>
MLib.Build_Library
(Object_Files.all,
Ali_Files.all,
Lib_Filename.all,
Lib_Dirpath.all);
when None =>
null;
end case;
Copy_ALI_Files
(Files => Ali_Files.all,
To => Copy_Dir,
Interfaces => Arguments (1 .. Argument_Number));
if Standalone
and then Projects.Table (For_Project).Library_Src_Dir /= No_Name
then
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;
Copy_Interface_Sources
(For_Project => For_Project,
Interfaces => Arguments (1 .. Argument_Number),
To_Dir => Copy_Dir);
end if;
end if;
Change_Dir (Current_Dir);
end Build_Library;
procedure Check (Filename : String) is
begin
if not Is_Regular_File (Filename) then
Com.Fail (Filename, " not found.");
end if;
end Check;
procedure Check_Context is
begin
for F in Object_Files'Range loop
Check (Object_Files (F).all);
end loop;
end Check_Context;
procedure Check_Library (For_Project : Project_Id) is
Data : constant Project_Data := Projects.Table (For_Project);
begin
if Data.Library
and then not Data.Need_To_Build_Lib
and then Data.Object_Directory /= No_Name
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;
begin
if Hostparm.OpenVMS then
B_Start (B_Start'Last) := '$';
end if;
Change_Dir (Get_Name_String (Data.Library_Dir));
Lib_TS := File_Stamp (Lib_Name);
Change_Dir (Get_Name_String (Data.Object_Directory));
Open (Dir => Object_Dir, Dir_Name => ".");
loop
Read (Object_Dir, Name_Buffer, Name_Len);
exit when Name_Len = 0;
if Is_Obj (Name_Buffer (1 .. Name_Len))
and then Name_Buffer (1 .. B_Start'Length) /= B_Start
then
Obj_TS := File_Stamp (Name_Find);
if String (Lib_TS) < String (Obj_TS) then
Projects.Table (For_Project).Need_To_Build_Lib := True;
exit;
end if;
end if;
end loop;
Change_Dir (Current);
end;
end if;
end Check_Library;
procedure Clean (Directory : Name_Id) is
Current : constant Dir_Name_Str := Get_Current_Dir;
Dir : Dir_Type;
Name : String (1 .. 200);
Last : Natural;
Disregard : Boolean;
begin
Get_Name_String (Directory);
begin
Change_Dir (Name_Buffer (1 .. Name_Len));
exception
when others =>
Com.Fail
("unable to access directory """,
Name_Buffer (1 .. Name_Len),
"""");
end;
Open (Dir, ".");
loop
Read (Dir, Name, Last);
exit when Last = 0;
if Is_Regular_File (Name (1 .. Last)) then
Set_Writable (Name (1 .. Last));
Delete_File (Name (1 .. Last), Disregard);
end if;
end loop;
Close (Dir);
Change_Dir (Current);
end Clean;
procedure Copy_Interface_Sources
(For_Project : Project_Id;
Interfaces : Argument_List;
To_Dir : Name_Id)
is
Current : constant Dir_Name_Str := Get_Current_Dir;
Target : constant Dir_Name_Str := Get_Name_String (To_Dir);
Text : Text_Buffer_Ptr;
The_ALI : ALI.ALI_Id;
Lib_File : Name_Id;
First_Unit : ALI.Unit_Id;
Second_Unit : ALI.Unit_Id;
Data : Unit_Data;
Copy_Subunits : Boolean := False;
procedure Copy (File_Name : Name_Id);
procedure Copy (File_Name : Name_Id) is
Success : Boolean := False;
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;
end Copy;
use ALI;
begin
Change_Dir
(Get_Name_String (Projects.Table (For_Project).Object_Directory));
for Index in Interfaces'Range loop
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 ALI.Units.Table (First_Unit).Utype = Is_Body then
Second_Unit := ALI.ALIs.Table (The_ALI).Last_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;
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;
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;
Change_Dir (Current);
end Copy_Interface_Sources;
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);
end loop;
Write_Eol;
end if;
end Display;
procedure Process_Binder_File (Name : String) is
Fd : FILEs;
Read_Mode : constant String := "r" & ASCII.Nul;
Status : Interfaces.C_Streams.int;
pragma Unreferenced (Status);
Begin_Info : constant String := "-- BEGIN Object file/option list";
End_Info : constant String := "-- END Object file/option list ";
Next_Line : String (1 .. 1000);
Nlast : Integer;
procedure 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;
begin
Fd := fopen (Name'Address, Read_Mode'Address);
if Fd = NULL_Stream then
Fail ("Failed to open binder output");
end if;
loop
Get_Next_Line;
exit when Next_Line (1 .. Nlast) = Begin_Info;
end loop;
loop
Get_Next_Line;
exit when Next_Line (1 .. Nlast) = End_Info;
Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
Nlast := Nlast - 8;
exit when Next_Line (1) = '-';
end loop;
if Next_Line (1 .. Nlast) /= End_Info then
loop
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, 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
if Add_Object_Files then
Opts.Increment_Last;
Opts.Table (Opts.Last) :=
new String'(Next_Line (1 .. Nlast));
end if;
else
Opts.Increment_Last;
Opts.Table (Opts.Last) :=
new String'(Next_Line (1 .. Nlast));
end if;
end if;
Get_Next_Line;
exit when Next_Line (1 .. Nlast) = End_Info;
Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
Nlast := Nlast - 8;
end loop;
end if;
Status := fclose (Fd);
end Process_Binder_File;
procedure Reset_Tables is
begin
Objects.Init;
Objects_Htable.Reset;
Foreigns.Init;
ALIs.Init;
Opts.Init;
Processed_Projects.Reset;
Library_Projs.Init;
end Reset_Tables;
end MLib.Prj;