|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 115712 (0x1c400)
Types: Ada Source
Notes: 03_class, FILE, Long Ada Source, R1k_Segment, e3_tag, package body Imports, seg_021203, separate Extensions_Support
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Io;
separate (Extensions_Support)
package body Imports is
-- If this is true, we will list the units in remote directories during
-- debugging.
List_Remote_Units : Boolean := False;
Remote_Cifo_Directory : constant String := "/usr/lib/alsycomp/cifo";
Remote_Posix_Directory : constant String := "/usr/lib/alsycomp/posix";
Cifo_Library : constant String :=
"!TARGETS.I386_UNIX_ALS_XT.TARGET_INTERFACE.CIFO";
Posix_Library : constant String :=
"!TARGETS.I386_UNIX_ALS_XT.TARGET_INTERFACE.POSIX";
function Detail (S : String := "") return String is
begin
if Debugging then
if S = "list" then
return " detail=brief";
-- or return " de=b";
else
return " detail=full";
-- or return " de=f";
end if;
else
return " detail=brief";
-- or return " de=b";
end if;
end Detail;
--[]
-- function Immediate_Imports (For_View : String) return Dt.Object.Iterator is
--
-- Imports : Object.Iterator := Dt.Naming.Resolution
-- (Cmvc.Imported_Views (For_View));
--
-- begin
-- return Imports;
-- end Immediate_Imports;
--
--
procedure Io_Put_Line (File : Io.File_Type;
Item : String) is
begin
if Debugging then
Log.Put_Line ("#~Batch file <= """ & Item & """", Profile.At_Msg);
end if;
Io.Put_Line (File, Item);
end Io_Put_Line;
function Is_Release_View (View : Directory.Object) return Boolean is
Cold : Boolean;
Error_Status : Directory.Error_Status;
begin
Directory.Object_Operations.Is_Frozen (The_Object => View,
Result => Cold, Status => Error_Status);
if Error_Status /= Directory.Successful then
return False;
end if;
return Cold;
end Is_Release_View;
--[]
-- function Ordered_Import_Closure
-- (For_View : String) return Dt.Object.Iterator is
--
-- Ordered_Imports : Object.Iterator :=
-- Dt.Naming.Resolution (Cmvc.Imported_Views (For_View, True));
--
-- begin
-- Object.Invert (Ordered_Imports);
--
-- return Ordered_Imports;
-- end Ordered_Import_Closure;
--
--
procedure Debug_Remote_List (Remote_Directory : String;
Remote_Connection : Rci.Context;
Status : in out Ss.Condition;
Trace_Command : Boolean) is
begin
if Debugging and then List_Remote_Units then
Rci_Execute_Command
-- (Command_Line =>
-- "ada u(" & Remote_Directory &
-- "/adalib,r).l u=* l=y" & Detail ("list"),
(Command_Line =>
"ada unit_manager\(" & Remote_Directory &
"/adalib,read\).list units=* link=yes" & Detail ("list"),
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Set_Status ("Can't list the units", Status);
end if;
end if;
end Debug_Remote_List;
procedure Set_Context (Old_Context : in out Naming.Context;
View_Obj : Directory.Object;
Status : in out Ss.Condition) is
Error_Status : Directory.Error_Status;
New_Context : Naming.Context;
begin
-- Get the current naming context for our view.
Naming.Get_Context (The_Context => New_Context,
The_Unit => View_Obj,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Set_Status ("Can't get default context for " &
Naming.Get_Full_Name (View_Obj) &
". Error Status = " &
Directory.Error_Status'Image (Error_Status), Status);
return;
end if;
-- Get the job's default naming context.
Old_Context := Naming.Default_Context;
-- We must restore this context (after any errors) before we return.
-- Change the job's default context to the unit's current context.
Naming.Set_Default_Context (The_Context => New_Context,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Set_Status ("Can't set default context to " &
Naming.Get_Full_Name (View_Obj) &
". Error Status = " &
Directory.Error_Status'Image (Error_Status), Status);
return;
end if;
end Set_Context;
procedure Reset_Context (Old_Context : Naming.Context) is
Error_Status : Directory.Error_Status;
begin
-- Restore the job's original naming context.
Naming.Set_Default_Context (The_Context => Old_Context,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Log.Put_Line ("Can't restore default context. Error Status = " &
Directory.Error_Status'Image (Error_Status),
Profile.Negative_Msg);
end if;
end Reset_Context;
function Get_Exports (View_Obj : Directory.Object) return Naming.Iterator is
Iter : Naming.Iterator;
Local_Status : Ss.Condition;
Old_Context : Naming.Context;
Status : Naming.Name_Status;
begin
-- Get the exports that are associated with View_Obj. The exports
-- are stored in a file in the view's State directory.
Set_Context (Old_Context => Old_Context,
View_Obj => View_Obj,
Status => Local_Status);
if Ss.Error (Status => Local_Status,
Level => Ss.Problem) then
Log.Put_Line ("#~" & Ss.Message (Local_Status),
Profile.Negative_Msg);
return Naming.Nil;
end if;
Naming.Resolve (Iter => Iter,
Source => "_" & Naming.Get_Full_Name (View_Obj) &
".State.Exports",
Status => Status);
if not Naming."=" (Status, Naming.Successful) then
Reset_Context (Old_Context);
return Naming.Nil;
end if;
Reset_Context (Old_Context);
return Iter;
end Get_Exports;
procedure Fetch_Exports (Imported_View : String;
Imported_Directory : String;
Remote_Connection : Rci.Context;
Status : in out Ss.Condition;
Trace_Command : Boolean) is
Exports : Naming.Iterator :=
Get_Exports (Du.Get_View (Imported_View, Profile.Get));
Exp : Directory.Object;
Error_Status : Directory.Error_Status;
begin
while not Naming.Done (Exports) loop
Naming.Get_Object (Iter => Exports,
The_Object => Exp,
Status => Error_Status);
if Error_Status = Directory.Successful then
declare
Nam : constant String := Su.Lower_Case
(Naming.Get_Simple_Name (Exp));
begin
-- Fetch the imported unit's closure.
Rci_Execute_Command
-- (Command_Line =>
-- "ada u(" & Imported_Directory &
-- "/adalib,u).f u=" & Nam &
-- " k=b s=c" & Detail,
(Command_Line =>
"ada unit_manager\(" & Imported_Directory &
"/adalib,update\).fetch unit=" & Nam &
" kind=body set=closure" & Detail,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Set_Status
("Can't fetch the closure for exported unit " & Nam,
Status);
end if;
end;
end if;
Naming.Next (Exports);
end loop;
end Fetch_Exports;
function Unix_Dir_Exists (Remote_Directory : String;
Remote_Connection : Rci.Context;
Trace_Command : Boolean) return Boolean is
Unix_Test_Command : constant String := "test -d " & Remote_Directory;
Local_Status : Ss.Condition;
begin
Rci_Execute_Command (Command_Line => Unix_Test_Command,
Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
if Ss.Error (Local_Status, Ss.Problem) then
if Debugging then
Log.Put_Line (Message => "#~" & Ss.Message (Local_Status),
Kind => Profile.Note_Msg);
end if;
if Debugging or else Trace_Command then
Log.Put_Line (Message =>
"#~The remote directory " &
Quot (Remote_Directory) & " does not exist",
Kind => Profile.Note_Msg);
end if;
return False;
end if;
if Debugging or else Trace_Command then
Log.Put_Line (Message => "#~The remote directory " &
Quot (Remote_Directory) & " exists",
Kind => Profile.Note_Msg);
end if;
return True;
end Unix_Dir_Exists;
procedure Copy_Adalib (Imported_View : String;
Host_View : String;
Into_Remote_Dir : String;
Remote_Connection : Rci.Context;
Status : in out Ss.Condition;
Trace_Command : Boolean) is
Ada_Family : constant String :=
Get_Family_Name (Du.Get_View (Host_View, Profile.Get),
Into_Remote_Dir);
Imported_View_Obj : Directory.Object :=
Du.Get_View (Imported_View, Profile.Get);
Imported_Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => Imported_View);
Imported_Directory : constant String :=
Su.Lower_Case (Imported_Directory_Result.Result
(1 .. Imported_Directory_Result.Size));
Imported_Family : constant String := Get_Family_Name (Imported_View_Obj, Imported_Directory);
Imported_Subsystem_Simple_Name : constant String :=
Su.Lower_Case (Naming.Get_Simple_Name
(Naming.Get_Prefix (Imported_View)));
Export_Set : constant String :=
Imported_Directory & "/adalib/export.set";
Imported_Subsystem_Directory : constant String :=
Ada_Family & "/imports/" & Imported_Subsystem_Simple_Name;
Export_Set_Exists : Boolean;
Imports_Directory_Exists : Boolean;
Remote_Directory_Exists : Boolean;
begin
if Debugging or else Trace_Command then
Log.Put_Line (Message => "#~Copy_Adalib (Imported_View" &
Qt (Imported_View) & ", Host_View" &
Qt (Host_View) & ", Into_Remote_Dir" &
Qt (Into_Remote_Dir) & ")",
Kind => Profile.Sharp_Msg);
end if;
if Problem (Imported_Directory_Result.Condition, Trace_Command) then
Set_Status ("Can't get remote directory name for imported view " &
Imported_View, Status);
return;
end if;
-- Don't continue if we can't derive family names from the specified
-- remote directories.
if Ada_Family'Length = 0 then
Set_Status ("Can't derive a family name from the remote pathname " &
Quot (Into_Remote_Dir), Status);
return;
elsif Imported_Family'Length = 0 then
Set_Status ("Can't derive a family name from the remote pathname " &
Quot (Imported_Directory), Status);
return;
end if;
Log.Put_Line (Message => "Executing Copy_Adalib",
Kind => Profile.Position_Msg);
-- Check for an existing Imported_Subsystem directory in the /imports
-- directory. If it exists, we already copied the subsystem into our
-- family, so we don't need to do anything more here.
Remote_Directory_Exists :=
Unix_Dir_Exists (Remote_Directory => Imported_Subsystem_Directory,
Remote_Connection => Remote_Connection,
Trace_Command => Trace_Command);
if Remote_Directory_Exists then
if Debugging or else Trace_Command then
Log.Put_Line ("#~The units in " &
Quot (Su.Upper_Case
(Imported_Subsystem_Simple_Name)) &
" have already been copied into " &
Quot (Into_Remote_Dir), Profile.Note_Msg);
end if;
return;
end if;
-- If the remote /imports directory doesn't exist in our family, we
-- will create it so we can put a copy of our export set into it.
Imports_Directory_Exists :=
Unix_Dir_Exists (Remote_Directory => Ada_Family & "/imports",
Remote_Connection => Remote_Connection,
Trace_Command => Trace_Command);
if not Imports_Directory_Exists then
Create_Remote_Directory
(Remote_Directory => Ada_Family & "/imports",
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status, Ss.Problem) then
return;
end if;
end if;
Debug_Remote_List (Remote_Directory => Imported_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
-- Does Imported_View already have an export set?
Export_Set_Exists := Unix_Dir_Exists
(Remote_Directory => Export_Set,
Remote_Connection => Remote_Connection,
Trace_Command => Trace_Command);
if not Export_Set_Exists then
-- The remote export set doesn't exist for Imported_View, so we
-- will create it and store it in the /adalib directory of
-- Imported_View.
-- Fetch the suppliers of all of its exports (which are in other
-- libraries in its family) into Imported_View's remote library.
Fetch_Exports (Imported_View => Imported_View,
Imported_Directory => Imported_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Set_Status ("Can't fetch the link's exports", Status);
return;
end if;
-- Create the view's export set.
Log.Put_Line (Message => "Creating export set for remote library " &
Quot (Imported_Directory),
Kind => Profile.Position_Msg);
Rci_Execute_Command
-- (Command_Line => "ada l(" & Imported_Family &
-- "\).c f=" & Imported_Directory &
-- "/adalib t=" & Export_Set &
-- " m=e" & Detail,
(Command_Line => "ada lib_manager\(" & Imported_Family &
"\).copy from=" & Imported_Directory &
"/adalib to=" & Export_Set &
" mode=export" & Detail,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Log.Put_Line ("Can't create the export set for " &
Quot (Su.Upper_Case (Imported_Directory)) &
". " & Ss.Message (Status), Profile.Error_Msg);
return;
end if;
end if;
-- Copy the imported view's export set to Into_Remote_Dir's /imports
-- directory. This will create a new library in Ada_Family.
Log.Put_Line (Message => "Copying export set " & Quot (Export_Set) &
" into remote library " &
Quot (Imported_Subsystem_Directory),
Kind => Profile.Position_Msg);
Rci_Execute_Command
-- (Command_Line => "ada l(" & Ada_Family &
-- "\).c f=" & Export_Set & " t=" &
-- Imported_Subsystem_Directory &
-- " m=i" & Detail,
(Command_Line => "ada lib_manager\(" & Ada_Family &
"\).copy from=" & Export_Set & " to=" &
Imported_Subsystem_Directory &
" mode=import" & Detail,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Log.Put_Line ("Can't copy the export set for " &
Quot (Imported_View) & ". " & Ss.Message (Status),
Profile.Error_Msg);
return;
end if;
Debug_Remote_List (Remote_Directory => Into_Remote_Dir,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
-- We could acquire all the units in the import set here, whether we
-- need them or not, but it will be more efficient to acquire any
-- needed units dynamically at compile time.
end Copy_Adalib;
procedure Perform_Remote_Import
(Host_View : String;
Views_To_Import : Directory.Naming.Iterator;
Remote_Machine : String;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => Host_View);
View_Directory : constant String :=
Directory_Result.Result (1 .. Directory_Result.Size);
Host_Family : constant String :=
Get_Family_Name (Du.Get_View (Host_View, Profile.Get),
View_Directory);
--[]
-- Ordered_Imports : Object.Iterator := Ordered_Import_Closure (Host_View);
-- Imports : Object.Iterator := Immediate_Imports (Host_View);
Imports : Naming.Iterator := Views_To_Import;
Imported_View_Obj : Directory.Object;
Error_Status : Directory.Error_Status;
Remote_Connection : Rci.Context;
Acquired : Boolean := False;
begin
if Debugging or else Trace_Command then
Log.Put_Line (Message => "#~Perform_Remote_Import (Host_View" &
Qt (Host_View) & ", Remote_Machine" &
Qt (Remote_Machine) & ")",
Kind => Profile.Sharp_Msg);
end if;
if Problem (Directory_Result.Condition, Trace_Command) then
Set_Status ("Can't get remote directory name for view " & Host_View,
Status);
return;
end if;
-- Don't continue if we can't derive a family name from the specified
-- View_Directory.
if Host_Family'Length = 0 then
Set_Status ("Can't derive a family name from the remote pathname " &
Quot (View_Directory), Status);
return;
end if;
if Naming.Done (Imports) then
-- Nothing to do here if there are no imports.
return;
end if;
--[]
-- if Object.Done (Ordered_Imports) and then Object.Done (Imports) then
-- -- Nothing to do here if there are no imports.
-- return;
-- end if;
--
Log.Put_Line (Message => "Executing Perform_Remote_Import",
Kind => Profile.Position_Msg);
--[]
--[while not Object.Done (Ordered_Imports) loop]
while not Naming.Done (Imports) loop
Naming.Get_Object (Iter => Imports,
The_Object => Imported_View_Obj,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Log.Put_Line ("Can't get imported view from iterator. " &
"Error Status = " &
Directory.Error_Status'Image (Error_Status),
Profile.Warning_Msg);
else
declare
--[]
-- View_In_Closure : constant String :=
-- Dt.Naming.Full_Name (Object.Value (Ordered_Imports));
-- Imported_View_Obj : Directory.Object :=
-- Du.Get_View (View_In_Closure, Profile.Get);
Imported_View : constant String :=
Naming.Get_Full_Name (Imported_View_Obj);
Imported_Family : constant String :=
Remote_Family (Imported_View_Obj);
begin
if Imported_Family'Length = 0 then
Log.Put_Line
("Imported view " & Imported_View &
" has no remote family name. Same family assumed",
Profile.Warning_Msg);
elsif Su.Equal (Imported_Family, Host_Family) then
-- The imported view is in the same family as its
-- importer, so we can skip it.
if Debugging then
Log.Put_Line ("#~Skipping view " & Imported_View &
" in importer's family",
Profile.Note_Msg);
end if;
else
if not Is_Release_View (Imported_View_Obj) then
Log.Put_Line ("Can only import view """ &
Imported_View &
""" from another family " &
"if it is a release view",
Profile.Error_Msg);
else
if not Acquired then
Rci.Acquire (Remote_Connection =>
Remote_Connection,
Status => Status,
Target_Key => Target_Key,
Remote_Machine => Remote_Machine,
Trace_Command => Debugging or else
Trace_Command);
if Problem (Status, Trace_Command) then
Set_Status
("Can't acquire a connection to " &
Remote_Machine, Status);
return;
end if;
Acquired := True;
end if;
-- It's a release view in a different family. Copy
-- it into our family.
Copy_Adalib (Imported_View => Imported_View,
Host_View => Host_View,
Into_Remote_Dir => View_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Set_Status
("Can't copy adalib for " &
Imported_View & " to " & Host_View, Status);
return;
end if;
end if;
end if;
end;
end if;
--[]
--[Object.Next (Ordered_Imports);]
Naming.Next (Imports);
end loop;
exception
when others =>
Unhandled_Exception (Status, "Perform_Remote_Import");
end Perform_Remote_Import;
procedure Import_Predefined_Unit (Imported_Unit : Directory.Object;
Into_View : Directory.Object;
The_Handle : Link_Table.Handle;
Remote_Directory : String;
Remote_Predef : String;
Remote_Connection : Rci.Context;
Status : in out Ss.Condition;
Trace_Command : Boolean) is
Simple_Name : constant String :=
Su.Lower_Case (Naming.Get_Simple_Name (Imported_Unit));
Imported_Unit_Name : constant String :=
Naming.Unique_Full_Name (Imported_Unit);
Remote_Adalib : constant String := Remote_Directory & "/adalib";
Element_To_Match : Remote_Links.Remote_Link;
Element_From_File : Remote_Links.Remote_Link;
Element_Position : Link_Table.File_Position;
Next_Free_Position : Link_Table.File_Position;
begi
if Debugging or else Trace_Command then
-- Print the name of the imported unit.
Log.Put_Line ("#~Import_Predefined_Unit (Imported_Unit" &
Qt (Imported_Unit_Name) & ", Into_View" &
Qt (Naming.Get_Full_Name (Into_View)) &
", Remote_Directory" & Qt (Remote_Directory) &
", Remote_Predef" & Qt (Remote_Predef) & ")",
Profile.Sharp_Msg);
end if;
-- Look up Imported_Unit in Into_View's link table. If it isn't there,
-- we must acquire it into Remote_Directory, and we must add it to the
-- link table. If it is there, we don't need to reacquire it.
--
Element_To_Match.Unit := Imported_Unit;
Element_To_Match.View := Imported_Unit;
Element_To_Match.Time := Calendar.Clock;
-- Look for the imported unit in the table.
Link_Table.Lookup (The_Handle, Element_To_Match, Element_From_File,
Element_Position, Next_Free_Position);
if not Link_Table.Is_Nil (The_Position => Element_Position) then
-- It's there, so we already acquired this predefined link unit
-- into our remote library.
if Debugging or else Trace_Command then
Log.Put_Line ("#~Reusing predefined link unit " &
Imported_Unit_Name & " in view " &
Naming.Get_Full_Name (Into_View),
Profile.Note_Msg);
end if;
return;
end if;
-- The imported unit is not in the table, so its link-unit hasn't been
-- acquired into Into_View. We will acquire it now.
Log.Put_Line (Message =>
"Acquiring link to " & Quot (Simple_Name) &
" from " & Quot (Remote_Predef) &
" into remote library " & Quot (Remote_Directory),
Kind => Profile.Position_Msg);
Rci_Execute_Command
-- (Command_Line =>
-- "ada u(" & Remote_Adalib &
-- ",u).a u=" & Simple_Name & " f=" &
-- Remote_Predef & Detail,
(Command_Line => "ada unit_manager\(" & Remote_Adalib &
",update\).acquire units=" & Simple_Name &
" from=" & Remote_Predef & Detail,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Log.Put_Line ("Can't acquire the predefined link. " &
Ss.Message (Status), Profile.Error_Msg);
else
-- List the results after the Acquire.
Debug_Remote_List (Remote_Directory => Remote_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
-- Create a new entry in the table to keep track of our link.
Link_Table.Update (The_Handle, Element_To_Match,
Next_Free_Position);
end if;
end Import_Predefined_Unit;
procedure Import_A_Unit (Imported_Unit : Directory.Object;
Into_View : Directory.Object;
The_Handle : Link_Table.Handle;
Remote_Directory : String;
Remote_Connection : Rci.Context;
Status : in out Ss.Condition;
Trace_Command : Boolean) is
Simple_Name : constant String :=
Su.Lower_Case (Naming.Get_Simple_Name (Imported_Unit));
Imported_Unit_Name : constant String :=
Naming.Unique_Full_Name (Imported_Unit);
Imported_View_Obj : Directory.Object :=
Du.Get_View (Imported_Unit, Profile.Get);
Imported_View_Name : constant String :=
Naming.Get_Full_Name (Imported_View_Obj);
Imported_Subsystem_Simple_Name : constant String :=
Su.Lower_Case (Naming.Get_Simple_Name
(Naming.Get_Prefix (Imported_View_Name)));
Imported_Remote_Result : constant Li.String_Result :=
Li.Remote_Directory (Imported_View_Name);
Imported_Remote_Directory : constant String :=
Imported_Remote_Result.Result;
Imported_Adalib : constant String :=
Imported_Remote_Directory & "/adalib";
Remote_Adalib : constant String := Remote_Directory & "/adalib";
Element_To_Match : Remote_Links.Remote_Link;
Element_From_File : Remote_Links.Remote_Link;
Element_Position : Link_Table.File_Position;
Next_Free_Position : Link_Table.File_Position;
Download_Time : Calendar.Time;
Remote_Family : constant String :=
Get_Family_Name (Into_View, Remote_Directory);
Imported_Family : constant String :=
Get_Family_Name (Imported_View_Obj, Imported_Remote_Directory);
Import_Directory_Exists : Boolean;
Same_Family : Boolean;
Imported_Subsystem_Directory : constant String :=
Remote_Family & "/imports/" & Imported_Subsystem_Simple_Name;
begin
if Debugging or else Trace_Command then
-- Print the name of the imported unit.
Log.Put_Line ("#~Import_A_Unit (Imported_Unit" &
Qt (Imported_Unit_Name) & ", Into_View" &
Qt (Naming.Get_Full_Name (Into_View)) &
", Remote_Directory" & Qt (Remote_Directory) & ")",
Profile.Sharp_Msg);
end if;
if Problem (Imported_Remote_Result.Condition, Trace_Command) then
Set_Status ("Can't get remote directory name for imported view " &
Imported_View_Name, Status);
return;
end if;
-- Don't continue if we can't derive family names from the specified
-- remote directories.
if Remote_Family'Length = 0 then
Set_Status ("Can't derive a family name from the remote pathname " &
Quot (Remote_Directory), Status);
return;
elsif Imported_Family'Length = 0 then
Set_Status ("Can't derive a family name from the remote pathname " &
Quot (Imported_Remote_Directory), Status);
return;
end if;
Same_Family := Su.Equal (Remote_Family, Imported_Family);
-- Acquire only the units that are actually needed for this
-- compilation (rather than Acquiring all units from a view, whether
-- needed or not, when we execute its Import command).
-- Look up Imported_Unit in Into_View's link table. If it isn't there,
-- we must acquire it into Remote_Directory, and we must add it to the
-- link table. If it is there and is valid (and is associated with
-- Imported_View_Name), we don't need to reacquire it.
Element_To_Match.Unit := Imported_Unit;
Element_To_Match.View := Imported_View_Obj;
Element_To_Match.Time := Calendar.Clock;
-- Look for the imported unit in the links table.
Link_Table.Lookup (The_Handle, Element_To_Match, Element_From_File,
Element_Position, Next_Free_Position);
if not Link_Table.Is_Nil (The_Position => Element_Position) then
-- It's there. Did it come from our view?
if Element_From_File.View /= Imported_View_Obj then
-- A link-unit with our name exists, but it came from some
-- other view. This should never happen.
Log.Put_Line ("Can't acquire link to " & Imported_Unit_Name,
Profile.Warning_Msg);
Log.Put_Line ("A link to " & Su.Upper_Case (Simple_Name) &
" already exists, but it came from view " &
Naming.Get_Full_Name (Element_From_File.View) &
", acquired on " &
Time_Utilities.Image
(Time_Utilities.Convert_Time
(Element_From_File.Time)),
Profile.Warning_Msg);
return;
end if;
-- A link-unit with our name exists, and it came from our view.
if Same_Family then
-- The imported unit is in a library in our family. Find out
-- when it was last downloaded.
Download_Time := Get_Download_Time (Imported_Unit);
if Calendar.">" (Download_Time, Element_From_File.Time) then
-- The imported unit was downloaded (recompiled or changed)
-- after we imported it, so we need to re-import it.
Log.Put_Line
("Imported unit " & Imported_Unit_Name &
" was recompiled or changed, so we must reacquire it",
Profile.Note_Msg);
-- Clear the table element for the obsolete unit.
Element_From_File.Unit := Directory.Nil;
Element_From_File.View := Directory.Nil;
Element_From_File.Time := Time_Utilities.Nil;
Link_Table.Update (The_Handle, Element_From_File,
Element_Position);
else
-- The imported unit is in our family, we already acquired
-- this particular link unit into our remote library, and
-- the unit has not been recompiled or changed, so we don't
-- need to acquire it again.
if Debugging or else Trace_Command then
Log.Put_Line ("#~Reusing link unit " &
Imported_Unit_Name & " in view " &
Naming.Get_Full_Name (Into_View),
Profile.Note_Msg);
end if;
return;
end if;
else
-- The imported unit is in another family (from a released
-- view), and we already acquired this particular link unit
-- into our remote library, so we don't need to acquire it
-- again.
if Debugging or else Trace_Command then
Log.Put_Line ("#~Reusing link unit " &
Imported_Unit_Name & " in view " &
Naming.Get_Full_Name (Into_View),
Profile.Note_Msg);
end if;
return;
end if;
end if;
-- The imported unit is not in the links table, so its link-unit hasn't
-- been acquired into Into_View. We will acquire it now.
if Same_Family then
-- Acquire the unit directly from its library (which is in our
-- family).
Log.Put_Line (Message =>
"Acquiring link to " & Quot (Simple_Name) &
" from " & Quot (Imported_Remote_Directory) &
" into remote library " &
Quot (Remote_Directory),
Kind => Profile.Position_Msg);
Rci_Execute_Command
-- (Command_Line =>
-- "ada u(" & Remote_Adalib &
-- ",u).a u=" & Simple_Name &
-- " f=" & Imported_Adalib &
-- " ov=y" & Detail,
(Command_Line => "ada unit_manager\(" & Remote_Adalib &
",update\).acquire units=" & Simple_Name &
" from=" & Imported_Adalib &
" overwrite=yes" & Detail,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
else
-- Acquire the unit from its import set (which should have been
-- copied during Cmvc.Import into a library in the /imports
-- directory in our family).
Import_Directory_Exists :=
Unix_Dir_Exists (Remote_Directory =>
Imported_Subsystem_Directory,
Remote_Connection => Remote_Connection,
Trace_Command => Trace_Command);
if not Import_Directory_Exists then
Set_Status
("Can't acquire the link " & Su.Upper_Case (Simple_Name) &
" because remote import directory " &
Imported_Subsystem_Directory & " doesn't exist", Status);
return;
end if;
Log.Put_Line (Message =>
"Acquiring link to " & Quot (Simple_Name) &
" from " & Quot (Imported_Subsystem_Directory) &
" into remote library " &
Quot (Remote_Directory),
Kind => Profile.Position_Msg);
Rci_Execute_Command
-- (Command_Line => "ada unit_manager\(" & Remote_Adalib &
-- ",update\).acquire units=" & Simple_Name &
-- " from=" & Imported_Subsystem_Directory &
-- " overwrite=yes" & Detail,
-- (Command_Line =>
-- "ada u(" & Remote_Adalib &
-- ",u).a u=" & Simple_Name &
-- " f=" & Imported_Subsystem_Directory &
-- " k=a b=c ov=y" & Detail,
(Command_Line =>
"ada unit_manager\(" & Remote_Adalib &
",update\).acquire units=" & Simple_Name &
" from=" & Imported_Subsystem_Directory &
--[ ????? or ]
--[" kind=body by=copy overwrite=yes" & Detail,]
" kind=all by=copy overwrite=yes" & Detail,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
end if;
if Problem (Status, Trace_Command) then
Log.Put_Line ("Can't acquire the prerequisite link. " &
Ss.Message (Status), Profile.Error_Msg);
else
-- List the results after the Acquire.
Debug_Remote_List (Remote_Directory => Remote_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
-- Create a new entry in the table for our link.
Link_Table.Update (The_Handle, Element_To_Match,
Next_Free_Position);
end if;
end Import_A_Unit;
procedure Batch_Import_Units
(Host_File_Id : Io.File_Type;
Imported_Units : Compilation_Interface.Unit_List;
Into_View : Directory.Object;
Remote_Directory : String;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
The_Handle : Link_Table.Handle;
Download_Time : Calendar.Time;
Remote_Family : constant String :=
Get_Family_Name (Into_View, Remote_Directory);
Same_Family : Boolean;
First_Library : Boolean := True;
New_Library : Boolean := True;
Unit_Obj : Directory.Object;
Current_View : Directory.Object;
Previous_View : Directory.Object := Directory.Nil;
Element_To_Match : Remote_Links.Remote_Link;
Element_From_File : Remote_Links.Remote_Link;
Element_Position : Link_Table.File_Position;
Next_Free_Position : Link_Table.File_Position;
procedure Call_Unit_Manager is
begin
if First_Library then
-- We need to generate a 'unit_manager' command for the
-- Remote_Directory before we can acquire our link unit.
--** unit_manager **
-- Io_Put_Line (Host_File_Id, "u " & Remote_Directory &
-- "/adalib u");
Io_Put_Line (Host_File_Id, "unit_manager " & Remote_Directory &
"/adalib update");
-- Generate the appropriate "default" commands.
if not Same_Family then
--** default **
--[ ????? or ]
--[Io_Put_Line (Host_File_Id, "default.acquire kind=body");]
--[ or Io_Put_Line (Host_File_Id, "d.a k=b");]
Io_Put_Line (Host_File_Id, "default.acquire kind=all");
-- or Io_Put_Line (Host_File_Id, "d.a k=a");
--** default **
Io_Put_Line (Host_File_Id, "default.acquire by=copy");
-- or Io_Put_Line (Host_File_Id, "d.a b=c");
end if;
--** default **
Io_Put_Line (Host_File_Id, "default.acquire overwrite=yes");
-- or Io_Put_Line (Host_File_Id, "d.a ov=y");
--** default **
Io_Put_Line (Host_File_Id, "default.acquire" & Detail);
-- or Io_Put_Line (Host_File_Id, "d.a" & Detail);
First_Library := False;
New_Library := True;
Previous_View := Current_View;
elsif Current_View = Previous_View then
-- We already generated a 'unit_manager' command, and the next
-- 'acquire' will access the same remote library.
New_Library := False;
else
-- We already generated a 'unit_manager' command, and the next
-- 'acquire' will access a different remote library.
New_Library := True;
Previous_View := Current_View;
end if;
end Call_Unit_Manager;
procedure Batch_Import_Predefined_Unit
(Imported_Unit : Directory.Object;
Remote_Predef : String) is
Simple_Name : constant String :=
Su.Lower_Case (Naming.Get_Simple_Name (Imported_Unit));
Imported_Unit_Name : constant String :=
Naming.Unique_Full_Name (Imported_Unit);
begin
if Debugging then
-- Print the name of the imported unit.
Log.Put_Line ("#~Batch_Import_Predefined_Unit (Imported_Unit" &
Qt (Imported_Unit_Name) & ", Remote_Predef" &
Qt (Remote_Predef) & ")", Profile.Sharp_Msg);
end if;
-- Look up Imported_Unit in the supplied link table. If it isn't
-- there, we must acquire it, and we must add it to the link table.
-- If it is there, we don't need to reacquire it.
--
Element_To_Match.Unit := Imported_Unit;
Element_To_Match.View := Imported_Unit;
Element_To_Match.Time := Calendar.Clock;
-- Look for the imported unit in the table.
Link_Table.Lookup (The_Handle, Element_To_Match, Element_From_File,
Element_Position, Next_Free_Position);
if not Link_Table.Is_Nil (The_Position => Element_Position) then
-- It's there, so we already acquired this predefined link unit
-- into our remote library.
if Debugging then
Log.Put_Line ("#~Reusing predefined link unit " &
Imported_Unit_Name, Profile.Note_Msg);
end if;
return;
end if;
-- Generate a new 'unit_manager' call if necessary.
Call_Unit_Manager;
-- The imported unit is not in the table, so its link-unit hasn't
-- been acquired. We will generate the batch commands to acquire
-- it.
if New_Library then
-- We are acquiring from a different remote library.
--** default **
Io_Put_Line (Host_File_Id,
"default.acquire from=" & Remote_Predef);
-- or Io_Put_Line (Host_File_Id, "d.a f=" & Remote_Predef);
end if;
--** acquire **
Io_Put_Line (Host_File_Id, "acquire units=" & Simple_Name);
-- or Io_Put_Line (Host_File_Id, "a u=" & Simple_Name);
-- Create a new entry in the table to keep track of our link.
Link_Table.Update (The_Handle, Element_To_Match,
Next_Free_Position);
end Batch_Import_Predefined_Unit;
procedure Batch_Import_A_Unit (Imported_Unit : Directory.Object) is
Simple_Name : constant String :=
Su.Lower_Case (Naming.Get_Simple_Name (Imported_Unit));
Imported_Unit_Name : constant String :=
Naming.Unique_Full_Name (Imported_Unit);
Imported_View_Obj : Directory.Object :=
Du.Get_View (Imported_Unit, Profile.Get);
Imported_View_Name : constant String :=
Naming.Get_Full_Name (Imported_View_Obj);
Imported_Subsystem_Simple_Name : constant String :=
Su.Lower_Case (Naming.Get_Simple_Name
(Naming.Get_Prefix (Imported_View_Name)));
Imported_Remote_Result : constant Li.String_Result :=
Li.Remote_Directory (Imported_View_Name);
Imported_Remote_Directory : constant String :=
Imported_Remote_Result.Result;
Imported_Adalib : constant String :=
Imported_Remote_Directory & "/adalib";
Imported_Family : constant String :=
Get_Family_Name (Imported_View_Obj, Imported_Remote_Directory);
Imported_Subsystem_Directory : constant String :=
Remote_Family & "/imports/" & Imported_Subsystem_Simple_Name;
begin
if Debugging then
-- Print the name of the imported unit.
Log.Put_Line ("#~Batch_Import_A_Unit (Imported_Unit" &
Qt (Imported_Unit_Name) & ")", Profile.Sharp_Msg);
end if;
if Problem (Imported_Remote_Result.Condition, Trace_Command) then
Set_Status
("Can't get remote directory name for imported view " &
Imported_View_Name, Status);
return;
end if;
-- Don't continue if we can't derive a family name from the
-- specified Imported_Remote_Directory.
if Imported_Family'Length = 0 then
Set_Status
("Can't derive a family name from the remote pathname " &
Quot (Imported_Remote_Directory), Status);
return;
end if;
Same_Family := Su.Equal (Remote_Family, Imported_Family);
-- Acquire only the units that are actually needed for this
-- compilation (rather than Acquiring all units from a view,
-- whether needed or not, when we execute its Import command).
-- Look up Imported_Unit in the given link table. If it isn't
-- there, we must acquire it into Remote_Directory, and we must add
-- it to the link table. If it is there and is valid (and is
-- associated with Imported_View_Name), we don't need to reacquire
-- it.
Element_To_Match.Unit := Imported_Unit;
Element_To_Match.View := Imported_View_Obj;
Element_To_Match.Time := Calendar.Clock;
-- Look for the imported unit in the links table.
Link_Table.Lookup (The_Handle, Element_To_Match, Element_From_File,
Element_Position, Next_Free_Position);
if not Link_Table.Is_Nil (The_Position => Element_Position) then
-- It's there. Did it come from our view?
if Element_From_File.View /= Imported_View_Obj then
-- A link-unit with our name exists, but it came from some
-- other view. This should never happen.
Log.Put_Line ("Can't acquire link to " & Imported_Unit_Name,
Profile.Warning_Msg);
Log.Put_Line ("A link to " & Su.Upper_Case (Simple_Name) &
" already exists, but it came from view " &
Naming.Get_Full_Name
(Element_From_File.View) &
", acquired on " &
Time_Utilities.Image
(Time_Utilities.Convert_Time
(Element_From_File.Time)),
Profile.Warning_Msg);
return;
end if;
-- A link-unit with our name exists, and it came from our view.
if Same_Family then
-- The imported unit is in a library in our family. Find
-- out when it was last downloaded.
Download_Time := Get_Download_Time (Imported_Unit);
if Calendar.">" (Download_Time, Element_From_File.Time) then
-- The imported unit was downloaded (recompiled or
-- changed) after we imported it, so we need to
-- re-import it.
Log.Put_Line ("Imported unit " & Imported_Unit_Name &
" was recompiled or changed, " &
"so we must reacquire it",
Profile.Note_Msg);
-- Clear the table element for the obsolete unit.
Element_From_File.Unit := Directory.Nil;
Element_From_File.View := Directory.Nil;
Element_From_File.Time := Time_Utilities.Nil;
Link_Table.Update (The_Handle, Element_From_File,
Element_Position);
else
-- The imported unit is in our family, we already
-- acquired this particular link unit into our remote
-- library, and the unit has not been recompiled or
-- changed, so we don't need to acquire it again.
if Debugging then
Log.Put_Line ("#~Reusing link unit " &
Imported_Unit_Name, Profile.Note_Msg);
end if;
return;
end if;
else
-- The imported unit is in another family (from a released
-- view), and we already acquired this particular link unit
-- into our remote library, so we don't need to acquire it
-- again.
if Debugging then
Log.Put_Line ("#~Reusing link unit " &
Imported_Unit_Name, Profile.Note_Msg);
end if;
return;
end if;
end if;
-- The imported unit is not in the links table, so its link-unit
-- hasn't been acquired. We will generate the commands to acquire
-- it now.
-- Generate a new 'unit_manager' call if necessary.
Call_Unit_Manager;
if Same_Family then
-- Generate the batch command to acquire the unit directly from
-- its library (which is in our family).
if New_Library then
-- We are acquiring from a different remote library.
--** default **
Io_Put_Line (Host_File_Id,
"default.acquire from=" & Imported_Adalib);
-- or Io_Put_Line (Host_File_Id, "d.a f=" & Imported_Adalib);
end if;
--** acquire **
Io_Put_Line (Host_File_Id, "acquire units=" & Simple_Name);
-- or Io_Put_Line (Host_File_Id, "a u=" & Simple_Name);
else
-- Generate the batch command to acquire the unit from its
-- import set (which should have been copied during Cmvc.Import
-- into a library in the /imports directory in our family).
if New_Library then
-- We are acquiring from a different remote library.
--** default **
Io_Put_Line (Host_File_Id, "default.acquire from=" &
Imported_Subsystem_Directory);
-- or Io_Put_Line (Host_File_Id, "d.a f=" & Imported_Subsystem_Directory);
end if;
--** acquire **
Io_Put_Line (Host_File_Id, "acquire units=" & Simple_Name);
-- or Io_Put_Line (Host_File_Id, "a u=" & Simple_Name);
end if;
-- Create a new entry in the table for our link.
Link_Table.Update (The_Handle, Element_To_Match,
Next_Free_Position);
end Batch_Import_A_Unit;
procedure Close_Table (The_Handle : in out Link_Table.Handle) is
begin
Link_Table.Close (The_Handle);
if Debugging then
Link_Table.Open (The_Handle, Remote_Links.File_Name (Into_View),
Link_Table.Read);
Log.Put_Line ("#~Link table " &
Remote_Links.File_Name (Into_View) & " contains:",
Profile.Note_Msg);
Link_Table.Dump (The_Handle);
Link_Table.Close (The_Handle);
end if;
exception
when others =>
null;
end Close_Table;
begin
if Debugging or else Trace_Command then
Log.Put_Line ("#~Batch_Import_Units (How_Many =>" &
Integer'Image (Imported_Units.Size) & ", Into_View" &
Qt (Naming.Get_Full_Name (Into_View)) &
", Remote_Directory" & Qt (Remote_Directory) & ")",
Profile.Sharp_Msg);
end if;
-- Don't continue if we can't derive a family name from the specified
-- Remote_Directory.
if Remote_Family'Length = 0 then
Set_Status ("Can't derive a family name from the remote pathname " &
Quot (Remote_Directory), Status);
return;
end if;
-- Open Into_View's file of acquired remote links. If the file doesn't
-- exist, it will be created.
Link_Table.Open (The_Handle => The_Handle,
Name => Remote_Links.File_Name (Into_View),
The_Mode => Link_Table.Read_Write);
for Index in Imported_Units.Data'First .. Imported_Units.Data'Last loop
begin
Unit_Obj := Imported_Units.Data (Index);
-- Units from the POSIX and CIFO libraries will be handled here
-- as special cases. Other predefined imports such as Text_Io
-- needn't be acquired here.
--
--** What about any other units in the INSTALLATION family?
if Du.Is_Predefined (Unit_Obj) then
declare
Unit_Name : constant String :=
Naming.Unique_Full_Name (Unit_Obj);
begin
if Unit_Name'Length > Cifo_Library'Length and then
Su.Equal (Unit_Name (Unit_Name'First ..
Unit_Name'First +
Cifo_Library'Length - 1),
Cifo_Library) then
Current_View := Du.Get_Object
(Cifo_Library, Profile.Get);
-- Generate the commands to acquire a link from
-- Remote_Directory to the remote counterpart of
-- Imported_Unit in CIFO.
Batch_Import_Predefined_Unit
(Imported_Unit => Unit_Obj,
Remote_Predef => Remote_Cifo_Directory);
if Problem (Status, Trace_Command) then
Log.Put_Line
("Can't import the prerequisite unit " &
Naming.Unique_Full_Name (Unit_Obj) &
" from the CIFO library",
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
elsif Unit_Name'Length > Posix_Library'Length and then
Su.Equal (Unit_Name
(Unit_Name'First ..
Unit_Name'First +
Posix_Library'Length - 1),
Posix_Library) then
Current_View := Du.Get_Object
(Posix_Library, Profile.Get);
-- Generate the commands to acquire a link from
-- Remote_Directory to the remote counterpart of
-- Imported_Unit in POSIX.
Batch_Import_Predefined_Unit
(Imported_Unit => Unit_Obj,
Remote_Predef => Remote_Posix_Directory);
if Problem (Status, Trace_Command) then
Log.Put_Line
("Can't import the prerequisite unit " &
Naming.Unique_Full_Name (Unit_Obj) &
" from the POSIX library",
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
elsif Debugging then
Log.Put_Line
("#~Skipping predefined unit " & Unit_Name,
Profile.Note_Msg);
end if;
end;
else
Current_View := Du.Get_View (Unit_Obj, Profile.Get);
-- Generate the commands to acquire a link from
-- Remote_Directory to the remote counterpart of
-- Imported_Unit.
Batch_Import_A_Unit (Imported_Unit => Unit_Obj);
if Problem (Status, Trace_Command) then
Log.Put_Line ("Can't import the prerequisite unit " &
Naming.Unique_Full_Name (Unit_Obj),
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
end if;
exception
when others =>
Log.Put_Line (Debug_Tools.Get_Exception_Name &
" caught in Import_Units",
Profile.Warning_Msg);
end;
end loop;
if not First_Library then
-- We generated a 'unit_manager' command.
--** quit **
Io_Put_Line (Host_File_Id, "quit");
-- or Io_Put_Line (Host_File_Id, "q");
end if;
Close_Table (The_Handle);
exception
when others =>
Close_Table (The_Handle);
Unhandled_Exception (Status, "Batch_Import_Units");
end Batch_Import_Units;
procedure Import_Units
(Imported_Units : Compilation_Interface.Unit_List;
Into_View : Directory.Object;
Remote_Directory : String;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
The_Handle : Link_Table.Handle;
Unit_Obj : Directory.Object;
procedure Close_Table (The_Handle : in out Link_Table.Handle) is
begin
Link_Table.Close (The_Handle);
if Debugging then
Link_Table.Open (The_Handle, Remote_Links.File_Name (Into_View),
Link_Table.Read);
Log.Put_Line ("#~Link table " &
Remote_Links.File_Name (Into_View) & " contains:",
Profile.Note_Msg);
Link_Table.Dump (The_Handle);
Link_Table.Close (The_Handle);
end if;
exception
when others =>
null;
end Close_Table;
begin
if Debugging or else Trace_Command then
Log.Put_Line ("#~Import_Units (How_Many =>" &
Integer'Image (Imported_Units.Size) & ", Into_View" &
Qt (Naming.Get_Full_Name (Into_View)) &
", Remote_Directory" & Qt (Remote_Directory) & ")",
Profile.Sharp_Msg);
end if;
-- Open Into_View's file of acquired remote links. If the file doesn't
-- exist, it will be created.
Link_Table.Open (The_Handle => The_Handle,
Name => Remote_Links.File_Name (Into_View),
The_Mode => Link_Table.Read_Write);
-- Note that it would be more efficient if we could execute the command
-- Exec ("ada unit_manager(" & Remote_Directory & "/adalib, update)");
-- and leave "ada unit_manager . . . " out of the "acquire" commands.
-- (That's how we will do the acquire's for Batch).
for Index in Imported_Units.Data'First .. Imported_Units.Data'Last loop
begin
Unit_Obj := Imported_Units.Data (Index);
-- Units from the POSIX and CIFO libraries will be handled here
-- as special cases. Other predefined imports such as Text_Io
-- needn't be acquired here.
--
--** What about any other units in the INSTALLATION family?
if Du.Is_Predefined (Unit_Obj) then
declare
Unit_Name : constant String :=
Naming.Unique_Full_Name (Unit_Obj);
begin
if Unit_Name'Length > Cifo_Library'Length and then
Su.Equal (Unit_Name (Unit_Name'First ..
Unit_Name'First +
Cifo_Library'Length - 1),
Cifo_Library) then
-- Acquire a link from Remote_Directory to the
-- remote counterpart of Imported_Unit in CIFO.
Import_Predefined_Unit
(Imported_Unit => Unit_Obj,
Into_View => Into_View,
The_Handle => The_Handle,
Remote_Directory => Remote_Directory,
Remote_Predef => Remote_Cifo_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Log.Put_Line
("Can't import the prerequisite unit " &
Naming.Unique_Full_Name (Unit_Obj),
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
elsif Unit_Name'Length > Posix_Library'Length and then
Su.Equal (Unit_Name
(Unit_Name'First ..
Unit_Name'First +
Posix_Library'Length - 1),
Posix_Library) then
-- Acquire a link from Remote_Directory to the
-- remote counterpart of Imported_Unit in POSIX.
Import_Predefined_Unit
(Imported_Unit => Unit_Obj,
Into_View => Into_View,
The_Handle => The_Handle,
Remote_Directory => Remote_Directory,
Remote_Predef => Remote_Posix_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Log.Put_Line
("Can't import the prerequisite unit " &
Naming.Unique_Full_Name (Unit_Obj),
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
elsif Debugging then
Log.Put_Line
("#~Skipping predefined unit " & Unit_Name,
Profile.Note_Msg);
end if;
end;
else
-- Acquire a link from Remote_Directory to the remote
-- counterpart of Imported_Unit.
Import_A_Unit (Imported_Unit => Unit_Obj,
Into_View => Into_View,
The_Handle => The_Handle,
Remote_Directory => Remote_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Log.Put_Line ("Can't import the prerequisite unit " &
Naming.Unique_Full_Name (Unit_Obj),
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
end if;
exception
when others =>
Log.Put_Line (Debug_Tools.Get_Exception_Name &
" caught in Import_Units",
Profile.Warning_Msg);
end;
end loop;
Close_Table (The_Handle);
exception
when others =>
Close_Table (The_Handle);
Unhandled_Exception (Status, "Import_Units");
end Import_Units;
procedure Remove_Imported_Units (View_To_Remove : Directory.Object;
From_View_Obj : Directory.Object;
Remote_Directory : String;
Remote_Connection : Rci.Context;
Status : in out Ss.Condition;
Trace_Command : Boolean) is
The_Handle : View_Table.Handle;
Element_To_Match : Remote_Links.Remote_Link;
Element_From_File : Remote_Links.Remote_Link;
Element_Poition : View_Table.File_Position;
Next_Free_Position : View_Table.File_Position;
procedure Close_Table (The_Handle : in out View_Table.Handle) is
begin
View_Table.Close (The_Handle);
if Debugging then
View_Table.Open (The_Handle,
Remote_Links.File_Name (From_View_Obj),
View_Table.Read);
Log.Put_Line ("#~Link table " &
Remote_Links.File_Name (From_View_Obj) &
" contains:", Profile.Note_Msg);
View_Table.Dump (The_Handle);
View_Table.Close (The_Handle);
end if;
exception
when others =>
null;
end Close_Table;
begin
-- Open From_View's file of acquired remote links. If the file does
-- not exist, it will be created (and it will be empty). View_Table.Open (The_Handle => The_Handle,
Name => Remote_Links.File_Name (From_View_Obj),
The_Mode => View_Table.Read_Write);
Element_To_Match.View := View_To_Remove;
loop
-- Find an element in the link table for a unit that is in
-- From_View.
View_Table.Lookup (The_Handle => The_Handle,
Element_To_Match => Element_To_Match,
Element_From_File => Element_From_File,
Element_Position => Element_Position,
Next_Free_Position => Next_Free_Position);
if View_Table.Is_Nil (The_Position => Element_Position) then
-- No (more) entries in the table for From_View.
exit;
end if;
-- Erase the link for this unit in Remote_Directory.
Log.Put_Line (Message =>
"Erasing link to " &
Quot (Su.Lower_Case
(Naming.Get_Simple_Name
(Element_From_File.Unit))) &
" from remote library " &
Quot (Remote_Directory),
Kind => Profile.Position_Msg);
Rci_Execute_Command
-- (Command_Line => "ada u(" & Remote_Directory &
-- "/adalib,u).e u=" &
-- Su.Lower_Case (Naming.Get_Simple_Name
-- (Element_From_File.Unit)) &
-- " c=n k=s",
(Command_Line =>
"ada unit_manager\(" & Remote_Directory &
"/adalib,update\).erase units=" &
Su.Lower_Case
(Naming.Get_Simple_Name (Element_From_File.Unit)) &
" confirm=no kind=spec",
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Log.Put_Line ("Can't remove the remote link. " &
Ss.Message (Status), Profile.Error_Msg);
exit;
end if;
-- Throw out the current table element. This doesn't really remove
-- the element from the file, but it does make the element
-- reusable.
Element_From_File.Unit := Directory.Nil;
Element_From_File.View := Directory.Nil;
Element_From_File.Time := Time_Utilities.Nil;
View_Table.Update (The_Handle, Element_From_File, Element_Position);
end loop;
Close_Table (The_Handle);
exception
when others =>
Close_Table (The_Handle);
Unhandled_Exception (Status, "Remove_Imported_Units");
end Remove_Imported_Units;
procedure Remove_Remote_Import
(View_To_Remove : Directory.Object;
From_View : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Connection : Remote_Command_Interface.Context;
Destroying_Library : Boolean;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
From_View_Obj : Directory.Object :=
Du.Get_View (From_View, Profile.Get);
Ada_Family : constant String := Get_Family_Name
(From_View_Obj, Remote_Directory);
View_Name : constant String := Naming.Get_Full_Name (View_To_Remove);
Imported_Subsystem_Simple_Name : constant String :=
Su.Lower_Case (Naming.Get_Simple_Name
(Naming.Get_Prefix (View_Name)));
Imports_Subdirectory : constant String := Ada_Family & "/imports";
Imported_Subsystem_Directory : constant String :=
Imports_Subdirectory & "/" & Imported_Subsystem_Simple_Name;
Remote_Directory_Exists : Boolean;
Remote_Connexion : Rci.Context := Remote_Connection;
Same_Family : Boolean;
begin
if Debugging or else Trace_Command then
Log.Put_Line (Message =>
"#~Remove_Remote_Import (View_To_Remove" &
Qt (View_Name) & ", From_View" &
Qt (From_View) & ", Remote_Machine" &
Qt (Remote_Machine) & ", Remote_Directory" &
Qt (Remote_Directory) &
", Destroying_Library => " &
Boolean'Image (Destroying_Library) & ")",
Kind => Profile.Sharp_Msg);
end if;
-- Don't continue if we can't derive a family name from the specified
-- Remote_Directory.
if Ada_Family'Length = 0 then
Set_Status ("Can't derive a family name from the remote pathname " &
Quot (Remote_Directory), Status);
return;
end if;
Log.Put_Line (Message => "Executing Remove_Remote_Import",
Kind => Profile.Position_Msg);
-- If we were called from Destroy_Library, we already acquired a
-- connection.
if not Destroying_Library then
Rci.Acquire (Remote_Connection => Remote_Connexion,
Status => Status,
Target_Key => Target_Key,
Remote_Machine => Remote_Machine,
Trace_Command => Debugging or else Trace_Command);
if Problem (Status, Trace_Command) then
Set_Status
("Can't acquire a connection to " & Remote_Machine, Status);
return;
end if;
end if;
Same_Family := Su.Equal (Ada_Family, Remote_Family (View_To_Remove));
-- Look in From_View's link table and remove the remote links to any
-- units in View_To_Remove. Each entry in the link table must contain
-- the unit name (a simple Ada name) and the name of the view that
-- contains the unit. Whenever we acquire a unit into From_View's
-- remote program library we must also create an entry in its link
-- table. When we remove View_To_Remove as an import of From_View,
-- we must also remove from From_View's link table all entries that
-- include View_To_Remove, i.e., all links to units in View_To_Remove.
Remove_Imported_Units (View_To_Remove => View_To_Remove,
From_View_Obj => From_View_Obj,
Remote_Directory => Remote_Directory,
Remote_Connection => Remote_Connexion,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Set_Status ("Can't remove the imported units", Status);
return;
end if;
if Same_Family then
-- Nothing more to do if View_To_Remove is in our Ada_Family.
return;
end if;
-- View_To_Remove is in a different family, so it must have been copied
-- into Ada_Family. Check for an existing Imported_Subsystem directory
-- in Remote_Directory's /imports subdirectory. If it exists, and if
-- no other view in Ada_Family imports it, we can remove the copied
-- library from Ada_Family.
Directory_Exists (Remote_Directory => Imported_Subsystem_Directory,
Remote_Connection => Remote_Connexion,
Status => Status,
Exists => Remote_Directory_Exists,
Trace_Command => Trace_Command);
if Ss.Error (Status, Ss.Problem) then
return;
end if;
if Remote_Directory_Exists then
if Destroying_Library then
-- If we are destroying the imported library, we want to remove
-- the copied library regardless of the host imports.
null;
else
-- View_To_Remove was copied from a different family into
-- Ada_Family. If any other view in Ada_Family imports it, we
-- can't remove the copied library.
declare
Referencers : constant Import_Interface.Unit_List :=
Import_Interface.Get_Referencers (View_To_Remove);
View_Obj : Directory.Object;
begin
if Ss.Error (Referencers.Condition) then
Status := Referencers.Condition;
return;
end if;
-- If any referencer of View_To_Remove is in our family, we
-- can't remove the copied import library.
for Index in Referencers.Data'First ..
Referencers.Data'Last loop
View_Obj := Referencers.Data (Index);
if Debugging then
-- Print the name of the referencer.
Log.Put_Line ("#~ Referencer" &
Integer'Image (Index) & ": " &
Naming.Get_Full_Name (View_Obj),
Profile.Note_Msg);
end if;
if View_Obj /= From_View_Obj and then
Su.Equal (Ada_Family, Remote_Family (View_Obj)) then
-- Another view in Ada_Family imports
-- View_To_Remove, so we can't remove its copied
-- import library.
return;
end if;
end loop;
end;
end if;
-- Nobody else in Ada_Family imports View_To_Remove, so we can
-- remove its copied import library. This will delete the library
-- from Ada_Family and destroy the Imported_Subsystem_Directory,
-- but it will leave Ada_Family's /imports subdirectory alone.
Log.Put_Line (Message => "Removing imported library, " &
"which was copied from another family",
Kind => Profile.Note_Msg);
Log.Put_Line (Message => "Erasing copied remote library " &
Quot (Imported_Subsystem_Directory),
Kind => Profile.Position_Msg);
Rci_Execute_Command
-- (Command_Line => "ada l(" & Ada_Family &
-- "\).e l=" &
-- Imported_Subsystem_Directory & " c=n",
(Command_Line => "ada lib_manager\(" & Ada_Family &
"\).erase libraries=" &
Imported_Subsystem_Directory & " confirm=no",
Remote_Connection => Remote_Connexion,
Status => Status,
Trace_Command => Trace_Command);
if Problem (Status, Trace_Command) then
Log.Put_Line ("Can't remove copied library " &
Quot (Imported_Subsystem_Directory) &
". " & Ss.Message (Status), Profile.Error_Msg);
return;
end if;
Debug_Remote_List (Remote_Directory => Remote_Directory,
Remote_Connection => Remote_Connexion,
Status => Status,
Trace_Command => Trace_Command);
else
-- View_To_Remove isn't a remote import of From_View.
Log.Put_Line
(Message =>
View_Name & " isn't remotely imported into " &
From_View & ", so it can't be removed as an import",
Kind => Profile.Warning_Msg);
end if;
exception
when others =>
Unhandled_Exception (Status, "Remove_Remote_Import");
end Remove_Remote_Import;
end Imports;
nblk1=70
nid=70
hdr6=de
[0x00] rec0=21 rec1=00 rec2=01 rec3=040
[0x01] rec0=00 rec1=00 rec2=6f rec3=004
[0x02] rec0=21 rec1=00 rec2=02 rec3=002
[0x03] rec0=00 rec1=00 rec2=6e rec3=010
[0x04] rec0=1d rec1=00 rec2=03 rec3=05c
[0x05] rec0=18 rec1=00 rec2=04 rec3=022
[0x06] rec0=16 rec1=00 rec2=05 rec3=082
[0x07] rec0=1c rec1=00 rec2=06 rec3=012
[0x08] rec0=18 rec1=00 rec2=07 rec3=028
[0x09] rec0=00 rec1=00 rec2=6d rec3=01e
[0x0a] rec0=1c rec1=00 rec2=08 rec3=03a
[0x0b] rec0=00 rec1=00 rec2=6c rec3=012
[0x0c] rec0=13 rec1=00 rec2=09 rec3=036
[0x0d] rec0=1a rec1=00 rec2=0a rec3=056
[0x0e] rec0=1c rec1=00 rec2=0b rec3=03a
[0x0f] rec0=15 rec1=00 rec2=0c rec3=002
[0x10] rec0=00 rec1=00 rec2=6b rec3=022
[0x11] rec0=16 rec1=00 rec2=0d rec3=048
[0x12] rec0=00 rec1=00 rec2=6a rec3=010
[0x13] rec0=1c rec1=00 rec2=0e rec3=056
[0x14] rec0=16 rec1=00 rec2=0f rec3=012
[0x15] rec0=16 rec1=00 rec2=10 rec3=07e
[0x16] rec0=13 rec1=00 rec2=11 rec3=04e
[0x17] rec0=14 rec1=00 rec2=12 rec3=07e
[0x18] rec0=15 rec1=00 rec2=13 rec3=000
[0x19] rec0=15 rec1=00 rec2=14 rec3=00c
[0x1a] rec0=15 rec1=00 rec2=15 rec3=00a
[0x1b] rec0=00 rec1=00 rec2=69 rec3=018
[0x1c] rec0=18 rec1=00 rec2=16 rec3=010
[0x1d] rec0=02 rec1=00 rec2=68 rec3=004
[0x1e] rec0=1c rec1=00 rec2=17 rec3=016
[0x1f] rec0=15 rec1=00 rec2=18 rec3=058
[0x20] rec0=12 rec1=00 rec2=19 rec3=02a
[0x21] rec0=00 rec1=00 rec2=67 rec3=004
[0x22] rec0=12 rec1=00 rec2=1a rec3=076
[0x23] rec0=14 rec1=00 rec2=1b rec3=004
[0x24] rec0=1b rec1=00 rec2=1c rec3=05a
[0x25] rec0=16 rec1=00 rec2=1d rec3=010
[0x26] rec0=00 rec1=00 rec2=66 rec3=002
[0x27] rec0=14 rec1=00 rec2=1e rec3=038
[0x28] rec0=15 rec1=00 rec2=1f rec3=01a
[0x29] rec0=15 rec1=00 rec2=20 rec3=03c
[0x2a] rec0=14 rec1=00 rec2=21 rec3=00a
[0x2b] rec0=15 rec1=00 rec2=22 rec3=04c
[0x2c] rec0=01 rec1=00 rec2=65 rec3=000
[0x2d] rec0=19 rec1=00 rec2=23 rec3=036
[0x2e] rec0=00 rec1=00 rec2=64 rec3=022
[0x2f] rec0=1b rec1=00 rec2=24 rec3=01c
[0x30] rec0=13 rec1=00 rec2=25 rec3=086
[0x31] rec0=13 rec1=00 rec2=26 rec3=052
[0x32] rec0=13 rec1=00 rec2=27 rec3=010
[0x33] rec0=14 rec1=00 rec2=28 rec3=064
[0x34] rec0=16 rec1=00 rec2=29 rec3=08e
[0x35] rec0=15 rec1=00 rec2=2a rec3=02a
[0x36] rec0=14 rec1=00 rec2=2b rec3=072
[0x37] rec0=13 rec1=00 rec2=2c rec3=016
[0x38] rec0=14 rec1=00 rec2=2d rec3=048
[0x39] rec0=1c rec1=00 rec2=2e rec3=06a
[0x3a] rec0=01 rec1=00 rec2=63 rec3=010
[0x3b] rec0=16 rec1=00 rec2=2f rec3=004
[0x3c] rec0=00 rec1=00 rec2=62 rec3=004
[0x3d] rec0=14 rec1=00 rec2=30 rec3=042
[0x3e] rec0=00 rec1=00 rec2=61 rec3=004
[0x3f] rec0=1a rec1=00 rec2=31 rec3=042
[0x40] rec0=00 rec1=00 rec2=60 rec3=004
[0x41] rec0=13 rec1=00 rec2=32 rec3=008
[0x42] rec0=18 rec1=00 rec2=33 rec3=048
[0x43] rec0=16 rec1=00 rec2=34 rec3=02c
[0x44] rec0=00 rec1=00 rec2=5f rec3=036
[0x45] rec0=17 rec1=00 rec2=35 rec3=000
[0x46] rec0=01 rec1=00 rec2=5e rec3=01a
[0x47] rec0=18 rec1=00 rec2=36 rec3=03e
[0x48] rec0=12 rec1=00 rec2=37 rec3=034
[0x49] rec0=12 rec1=00 rec2=38 rec3=080
[0x4a] rec0=12 rec1=00 rec2=39 rec3=02c
[0x4b] rec0=13 rec1=00 rec2=3a rec3=092
[0x4c] rec0=19 rec1=00 rec2=3b rec3=01c
[0x4d] rec0=11 rec1=00 rec2=3c rec3=09e
[0x4e] rec0=19 rec1=00 rec2=3d rec3=04c
[0x4f] rec0=1b rec1=00 rec2=3e rec3=078
[0x50] rec0=15 rec1=00 rec2=3f rec3=05a
[0x51] rec0=11 rec1=00 rec2=40 rec3=048
[0x52] rec0=11 rec1=00 rec2=41 rec3=066
[0x53] rec0=13 rec1=00 rec2=42 rec3=026
[0x54] rec0=17 rec1=00 rec2=43 rec3=04c
[0x55] rec0=1d rec1=00 rec2=44 rec3=000
[0x56] rec0=1c rec1=00 rec2=45 rec3=062
[0x57] rec0=14 rec1=00 rec2=46 rec3=06e
[0x58] rec0=12 rec1=00 rec2=47 rec3=01c
[0x59] rec0=10 rec1=00 rec2=48 rec3=03e
[0x5a] rec0=10 rec1=00 rec2=49 rec3=054
[0x5b] rec0=15 rec1=00 rec2=4a rec3=04a
[0x5c] rec0=13 rec1=00 rec2=4b rec3=064
[0x5d] rec0=1b rec1=00 rec2=4c rec3=024
[0x5e] rec0=00 rec1=00 rec2=5d rec3=002
[0x5f] rec0=1a rec1=00 rec2=4d rec3=080
[0x60] rec0=01 rec1=00 rec2=5c rec3=002
[0x61] rec0=15 rec1=00 rec2=4e rec3=02c
[0x62] rec0=12 rec1=00 rec2=4f rec3=03c
[0x63] rec0=18 rec1=00 rec2=50 rec3=014
tail 0x2171d58da838d6b4e35fa 0x42a00088462065003
Free Block Chain:
0x70: 0000 00 00 0c 80 28 81 81 80 05 20 14 2e 00 a6 06 05 ┆ ( . ┆