|
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: 63488 (0xf800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Extensions_Support, seg_04cf9c
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Compiler_Location;
with Debug_Tools;
with Library_Interface;
with Log;
with Object_Subclass;
with Profile;
with String_Utilities;
with View_Support;
package body Extensions_Support is
package Li renames Library_Interface;
package Rci renames Remote_Command_Interface;
package Ss renames Simple_Status;
package Su renames String_Utilities;
Target_Key : constant String := "mc68k_bare_vads";
function "=" (L, R : Directory.Error_Status) return Boolean
renames Directory."=";
function "=" (L, R : Directory.Object) return Boolean renames Directory."=";
function "=" (L, R : Directory.Subclass) return Boolean
renames Directory."=";
function Qt (Str : String) return String is
begin
return " => """ & Str & """";
end Qt;
procedure Set_Status (Message : String;
Status : in out Simple_Status.Condition;
Severity : Simple_Status.Condition_Class :=
Simple_Status.Problem;
Error_Type : String := "Library_Extensions Error") is
begin
Ss.Create_Condition (Status => Status,
Error_Type => Error_Type,
Message => Message,
Severity => Severity);
end Set_Status;
procedure Unhandled_Exception (Status : in out Simple_Status.Condition;
Routine : String) is
begin
Set_Status (Message =>
Debug_Tools.Get_Exception_Name & " caught in " & Routine,
Status => Status,
Error_Type => "Unhandled exception ");
end Unhandled_Exception;
function Is_View (Obj : Directory.Object) return Boolean is
Subclass : Directory.Subclass := Directory.Get_Subclass (Obj);
begin
return (Subclass = Object_Subclass.Spec_View_Subclass) or else
(Subclass = Object_Subclass.Load_View_Subclass) or else
(Subclass = Object_Subclass.Combined_View_Subclass);
end Is_View;
function Get_View (Object : Directory.Object) return Directory.Object is
Obj : Directory.Object := Object;
E_Status : Directory.Error_Status;
Obj_Unit : Directory.Ada.Unit;
begin
if Is_View (Obj) then
return Obj;
end if;
Directory.Control_Point.Enclosing_World (Obj, Obj_Unit, E_Status);
if Directory."/=" (E_Status, Directory.Successful) then
return Directory.Nil;
end if;
Obj := Directory.Ada.Get_Object (Obj_Unit);
if Is_View (Obj) then
return Obj;
else
return Directory.Nil;
end if;
-- if you are here, an error occurred
return Directory.Nil;
end Get_View;
function Get_View (Object_Name : String) return Directory.Object is
Obj : Directory.Object;
Status : Naming.Name_Status;
begin
Naming.Resolve (Object_Name, Obj, Status);
if Naming."/=" (Status, Naming.Successful) then
Log.Put_Line (Object_Name & " not found", Profile.Warning_Msg);
return Directory.Nil;
end if;
return Get_View (Obj);
end Get_View;
function Get_Object (Object_Name : String) return Directory.Object is
Obj : Directory.Object;
Status : Naming.Name_Status;
begin
Naming.Resolve (Object_Name, Obj, Status);
if Naming."/=" (Status, Naming.Successful) then
return Directory.Nil;
end if;
return Obj;
end Get_Object;
function Trace_Flag return Boolean is
begin
return False;
end Trace_Flag;
procedure Do_Import (Remote_Import_Directory : String;
To_View : Directory.Object;
Remote_Connection : Rci.Context;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
View_Name : constant String := Naming.Get_Full_Name (To_View);
Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => View_Name);
Remote_Directory : constant String := Directory_Result.Result;
Set_Directory_Command : constant String := "cd " & Remote_Directory;
Add_Import_Cmd : constant String :=
Compiler_Location.The_Path_With & "a.path -L ";
Add_Import_Command : constant String :=
Add_Import_Cmd & Remote_Directory & " -i " & Remote_Import_Directory;
Exists : Boolean;
procedure Import_Exists (Remote_View : String;
Exists : out Boolean) is
Local_Status : Ss.Condition;
Import_Exists_Command : constant String :=
Compiler_Location.The_Path_With &
"a.path>a.path_temp;egrep -s " & Remote_View & " a.path_temp";
begin
if Trace_Command then
Log.Put_Line (Message => "Import_Exists (Remote_View" &
Qt (Remote_View) & ")",
Kind => Profile.Sharp_Msg);
end if;
Exists := False;
if Trace_Command then
Log.Put_Line ("Import_Exists_Command" &
Qt (Import_Exists_Command), Profile.At_Msg);
end if;
Rci.Execute_Command (Command_Line => Import_Exists_Command,
Remote_Connection => Remote_Connection,
Status => Local_Status,
Error_Pattern => "", -- ignored
Parse_Error_Output => False, -- ignored
Parse_Standard_Output => False, -- ignored
Show_Parsed_Output => True, -- ignored
Trace_Command => Trace_Command);
if Ss.Error (Local_Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Local_Status), Profile.At_Msg);
Log.Put_Line ("View """ & Remote_View &
""" has not yet been imported",
Profile.Note_Msg);
end if;
else
if Trace_Command then
Log.Put_Line ("View """ & Remote_View &
""" was previously imported",
Profile.Note_Msg);
end if;
Exists := True;
end if;
end Import_Exists;
begin
if Trace_Command then
Log.Put_Line (Message => "Do_Import (Remote_Import_Directory" &
Qt (Remote_Import_Directory) &
", To_View" & Qt (View_Name) & ")",
Kind => Profile.Sharp_Msg);
end if;
if Ss.Error (Directory_Result.Condition) then
if Trace_Command then
Log.Put_Line (Ss.Message (Directory_Result.Condition),
Profile.Negative_Msg);
end if;
Set_Status ("Can't get remote directory name for view " & View_Name,
Status);
return;
end if;
if Su.Strip (Remote_Directory) = "" then
Log.Put_Line ("Name of remote directory for view " &
View_Name & " is null", Profile.Warning_Msg);
return;
elsif Su.Strip (Remote_Import_Directory) = "" then
Log.Put_Line ("Name of remote library to be imported into view " &
View_Name & " is null", Profile.Warning_Msg);
return;
end if;
if Trace_Command then
Log.Put_Line ("Set_Directory_Command" & Qt (Set_Directory_Command),
Profile.At_Msg);
end if;
Rci.Execute_Command (Command_Line => Set_Directory_Command,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
-- Remote_Directory doesn't exist, so we certainly can't import
-- into it.
if Trace_Command then
Log.Put_Line (Ss.Message (Status), Profile.Warning_Msg);
end if;
Log.Put_Line ("Can't add import " & Remote_Import_Directory & " to nonexistent remote library " & Remote_Directory,
Profile.Warning_Msg);
Ss.Initialize (Status);
return;
end if;
-- See if the Remote_Import_Directory exists.
Rci.File_Exists (The_File => Remote_Import_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Exists => Exists,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status), Profile.Warning_Msg);
end if;
Log.Put_Line ("Can't tell whether remote Ada library """ &
Remote_Import_Directory & """ exists",
Profile.Warning_Msg);
Ss.Initialize (Status);
return;
elsif not Exists then
Log.Put_Line ("Can't import nonexistent remote library " &
Remote_Import_Directory &
" into library " & Remote_Directory,
Profile.Warning_Msg);
return;
end if;
-- Both Remote_Directory and Remote_Import_Directory exist on the
-- remote machine. Is the Remote_Import_Directory already imported?
Import_Exists (Remote_View => Remote_Import_Directory,
Exists => Exists);
if not Exists then
-- This view isn't yet imported, so we will add it now.
if Trace_Command then
Log.Put_Line ("Add_Import_Command" & Qt (Add_Import_Command),
Profile.At_Msg);
end if;
Rci.Execute_Command (Command_Line => Add_Import_Command,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
end if;
Set_Status ("Can't add import " & Remote_Import_Directory &
" to remote library " & Remote_Directory, Status);
end if;
end if;
exception
when others =>
Unhandled_Exception (Status, "Do_Import");
end Do_Import;
procedure Refresh_Referencers
(To_View : Directory.Object;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
View_Name : constant String := Naming.Get_Full_Name (To_View);
Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => View_Name);
Remote_Directory : constant String := Directory_Result.Result;
Referencer : Directory.Object;
Referencers : constant View_Support.Unit_List :=
View_Support.Get_Referencers (To_View, True);
begin
if Trace_Command then
Log.Put_Line (Message => "Refresh_Referencers (To_View" &
Qt (View_Name) & ")",
Kind => Profile.Sharp_Msg);
end if;
if Ss.Error (Directory_Result.Condition) then
if Trace_Command then
Log.Put_Line (Ss.Message (Directory_Result.Condition),
Profile.Negative_Msg);
end if;
Set_Status ("Can't get remote directory name for view " & View_Name,
Status);
return;
end if;
if Ss.Error (Referencers.Condition) then
if Trace_Command then
Log.Put_Line (Ss.Message (Referencers.Condition),
Profile.Negative_Msg);
end if;
Set_Status ("Can't get referencers for view " & View_Name, Status);
return;
end if;
-- Add To_View's remote directory as an import for each of its
-- referencers on the Sparc.
for Index in 1 .. Referencers.Size loop
Referencer := Referencers.Data (Index);
if Trace_Command then
Log.Put_Line (". Referencers (" & Integer'Image (Index) &
", " & View_Name & ") => " &
Naming.Get_Full_Name (Referencer),
Profile.At_Msg);
end if;
if Referencer /= To_View then
Do_Import (Remote_Import_Directory => Remote_Directory,
To_View => Referencer,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Warning_Msg);
Log.Put_Line ("Can't add remote import for " &
Naming.Get_Full_Name (Referencer),
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
end if;
end loop;
end Refresh_Referencers;
procedure Add_Remote_Import
(Imported_View : Directory.Object;
To_View : Directory.Object;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
Import_Name : constant String := Naming.Get_Full_Name (Imported_View);
Import_Result : constant Li.String_Result :=
Li.Remote_Directory (View => Import_Name);
Remote_Import_Directory : constant String := Import_Result.Result;
Referencer : Directory.Object;
Referencers : constant View_Support.Unit_List :=
View_Support.Get_Referencers (To_View, True);
begin
if Trace_Command then
Log.Put_Line (Message =>
"Add_Remote_Import (Imported_View" &
Qt (Import_Name) & ", To_View" &
Qt (Naming.Get_Full_Name (To_View)) & ")",
Kind => Profile.Sharp_Msg);
end if;
if Ss.Error (Import_Result.Condition) then
if Trace_Command then
Log.Put_Line (Ss.Message (Import_Result.Condition),
Profile.Negative_Msg);
end if;
Set_Status ("Can't get remote directory name for imported view " &
Import_Name, Status);
return;
end if;
if Ss.Error (Referencers.Condition) then
if Trace_Command then
Log.Put_Line (Ss.Message (Referencers.Condition),
Profile.Negative_Msg);
end if;
Set_Status ("Can't get referencers for view " &
Naming.Get_Full_Name (To_View), Status);
return;
end if;
if Imported_View = To_View then
return;
end if;
-- Add Imported_View's remote directory to To_View's import list on
-- the Sparc.
Do_Import (Remote_Import_Directory => Remote_Import_Directory,
To_View => To_View,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Warning_Msg);
Log.Put_Line ("Can't add remote import for " &
Naming.Get_Full_Name (To_View), Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
-- Now add Imported_View's remote directory as an import for each of
-- To_View's referencers on the Sparc.
for Index in 1 .. Referencers.Size loop
Referencer := Referencers.Data (Index);
if Trace_Command then
Log.Put_Line (". Referencers (" & Integer'Image (Index) &
", " & Naming.Get_Full_Name (To_View) &
") => " & Naming.Get_Full_Name (Referencer),
Profile.At_Msg);
end if;
if Referencer /= Imported_View and then Referencer /= To_View then
Do_Import (Remote_Import_Directory => Remote_Import_Directory,
To_View => Referencer,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Warning_Msg);
Log.Put_Line ("Can't add remote import for " &
Naming.Get_Full_Name (Referencer),
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
end if;
end loop;
end Add_Remote_Import;
procedure Add_Remote_Imports
(Imported_Views : in out Directory.Naming.Iterator;
To_View : Directory.Object;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
Imports : Naming.Iterator := Imported_Views;
Error_Status : Directory.Error_Status;
Import_Object : Directory.Object;
begin
if Trace_Command then
Log.Put_Line (Message =>
"Add_Remote_Imports (To_View" &
Qt (Naming.Get_Full_Name (To_View)) & ")",
Kind => Profile.Sharp_Msg);
while not Naming.Done (Imports) loop
Log.Put_Line (Message => ". Imported_View => " &
Naming.Source_Name (Imports),
Kind => Profile.Sharp_Msg);
Naming.Next (Imports);
end loop;
Naming.Reset (Imported_Views);
end if;
-- Make sure that To_View's remote library is imported by each of its
-- referencers.
Refresh_Referencers (To_View => To_View,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
Ss.Initialize (Status);
end if;
-- Now set up a remote link from To_View (and each of its referencers)
-- to each Imported_View (and each of its imports).
while not Naming.Done (Imported_Views) loop
Naming.Get_Object (Iter => Imported_Views,
The_Object => Import_Object,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Set_Status
("Can't get object for " &
Naming.Source_Name (Imported_Views) & ". Error Status = " &
Directory.Error_Status'Image (Error_Status),
Status);
return;
end if;
if Trace_Command then
Log.Put_Line (". Imported_View => " &
Naming.Get_Full_Name (Import_Object),
Profile.Sharp_Msg);
end if;
-- Add a link on the remote Sparc from To_View (and each of its
-- referencers) to the imported view.
Add_Remote_Import (Imported_View => Import_Object,
To_View => To_View,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
Ss.Initialize (Status);
end if;
-- Now get the view's import closure, and add the remote
-- directories for all of the views in the closure to To_View's
-- (and each of its referencers) remote import list.
declare
Import : Directory.Object;
Import_Closure : constant View_Support.Unit_List :=
View_Support.Get_Imports (For_View => Import_Object,
Closure => True);
begin
if Ss.Error (Import_Closure.Condition) then
Log.Put_Line (Ss.Message (Import_Closure.Condition),
Profile.Negative_Msg);
Set_Status ("Can't get import closure for view " &
Naming.Get_Full_Name (Import_Object), Status);
return;
end if;
for Index in 1 .. Import_Closure.Size loop
Import := Import_Closure.Data (Index);
if Trace_Command then
Log.Put_Line (". Import_Closure (" &
Integer'Image (Index) & ", " &
Naming.Get_Full_Name (Import_Object) &
") => " & Naming.Get_Full_Name (Import),
Profile.At_Msg);
end if;
if Import /= To_View and then Import /= Import_Object then
Add_Remote_Import
(Imported_View => Import,
To_View => To_View,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status),
Profile.Negative_Msg);
Ss.Initialize (Status);
end if;
end if;
end loop;
end;
Naming.Next (Imported_Views);
end loop;
exception
when others =>
Unhandled_Exception (Status, "Add_Remote_Imports");
end Add_Remote_Imports;
procedure Remove_Remote_Import
(View_To_Remove : Directory.Object;
From_View : Directory.Object;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
Imported_View : constant String :=
Naming.Get_Full_Name (View_To_Remove);
Imported_Result : constant Li.String_Result :=
Li.Remote_Directory (View => Imported_View);
Remote_Import_Directory : constant String := Imported_Result.Result;
Dir_Exists : Boolean;
From_View_Name : constant String := Naming.Get_Full_Name (From_View);
Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => From_View_Name);
Remote_Directory : constant String := Directory_Result.Result;
Remove_Import_Cmd : constant String :=
Compiler_Location.The_Path_With & "a.path -L ";
Remove_Import_Command : constant String :=
Remove_Import_Cmd & Remote_Directory &
" -r " & Remote_Import_Directory;
begin
if Trace_Command then
Log.Put_Line (Message => "Remove_Remote_Import (View_To_Remove" &
Qt (Imported_View) & ", From_View" &
Qt (From_View_Name) & ")",
Kind => Profile.Sharp_Msg);
end if;
if Ss.Error (Imported_Result.Condition) then
if Trace_Command then
Log.Put_Line (Ss.Message (Imported_Result.Condition),
Profile.Negative_Msg);
end if;
Set_Status ("Can't get remote directory name for imported view " &
Imported_View, Status);
return;
elsif Ss.Error (Directory_Result.Condition) then
if Trace_Command then
Log.Put_Line (Ss.Message (Directory_Result.Condition),
Profile.Negative_Msg);
end if;
Set_Status
("Can't get remote directory name for view " & From_View_Name,
Status);
return;
end if;
if Remote_Directory = "" then
Log.Put_Line (Message => "Remote directory name for view " &
From_View_Name & " is null",
Kind => Profile.Warning_Msg);
Set_Status ("Insufficient remote library information",
Status, Ss.Problem);
return;
elsif Remote_Import_Directory = "" then
Log.Put_Line (Message =>
"Remote directory name for imported view " &
Imported_View & " is null",
Kind => Profile.Warning_Msg);
Set_Status ("Insufficient remote library information",
Status, Ss.Problem);
return;
end if;
-- See if the Remote_Directory exists.
Rci.File_Exists (The_File => Remote_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Exists => Dir_Exists,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
end if;
Set_Status
("Can't tell whether remote directory """ &
Remote_Directory & """ exists, so can't remove its import",
Status);
return;
end if;
if not Dir_Exists then
Log.Put_Line ("Remote directory """ & Remote_Directory &
""" doesn't exist for view " & From_View_Name &
", so we can't remove its import",
Profile.Warning_Msg);
return;
end if;
if Trace_Command then
Log.Put_Line ("Remove_Import_Command" & Qt (Remove_Import_Command) &
", View_To_Remove" & Qt (Imported_View),
Profile.At_Msg);
end if;
Rci.Execute_Command (Command_Line => Remove_Import_Command,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
end if;
Set_Status ("Can't remove remote import " & Imported_View &
" from view " & From_View_Name, Status);
end if;
end Remove_Remote_Import;
procedure Remove_Unused_Import
(View_To_Remove : Directory.Object;
From_View : Directory.Object;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Ss.Condition;
Trace_Command : Boolean) is
Importing_Closure : constant View_Support.Unit_List :=
View_Support.Get_Imports (From_View, True);
begin
if Ss.Error (Importing_Closure.Condition) then
Log.Put_Line (Ss.Message (Importing_Closure.Condition),
Profile.Negative_Msg);
Set_Status ("Can't get import closure for view " &
Naming.Get_Full_Name (From_View), Status);
return;
end if;
if not View_Support.Is_Member (View_To_Remove, Importing_Closure) then
Remove_Remote_Import (View_To_Remove => View_To_Remove,
From_View => From_View,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
end if;
end Remove_Unused_Import;
procedure Remove_All_Remote_Imports
(View_To_Remove : Directory.Object;
From_View : Directory.Object;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
Import_Name : constant String := Naming.Get_Full_Name (View_To_Remove);
Referencer : Directory.Object;
Referencers : constant View_Support.Unit_List :=
View_Support.Get_Referencers (From_View, True);
begin
if Trace_Command then
Log.Put_Line (Message =>
"Remove_All_Remote_Imports (View_To_Remove" &
Qt (Import_Name) & ", From_View" &
Qt (Naming.Get_Full_Name (From_View)) & ")",
Kind => Profile.Sharp_Msg);
end if;
if Ss.Error (Referencers.Condition) then
if Trace_Command then
Log.Put_Line (Ss.Message (Referencers.Condition),
Profile.Negative_Msg);
end if;
Set_Status ("Can't get referencers for view " &
Naming.Get_Full_Name (From_View), Status);
return;
end if;
Remove_Unused_Import (View_To_Remove, From_View,
Remote_Connection, Status, Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Warning_Msg);
Log.Put_Line ("Remote library for " & Import_Name &
" isn't on search list for " &
Naming.Get_Full_Name (From_View),
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
-- Now remove all of the specified view's imports as remote imports
-- of From_View (unless they are required by another of From_View's
-- imports).
for Index in 1 .. Referencers.Size loop
Referencer := Referencers.Data (Index);
if Trace_Command then
Log.Put_Line (". Referencers (" & Integer'Image (Index) &
", " & Naming.Get_Full_Name (From_View) &
") => " & Naming.Get_Full_Name (Referencer),
Profile.At_Msg);
end if;
if Referencer /= View_To_Remove and then
Referencer /= From_View then
Remove_Unused_Import (View_To_Remove, Referencer,
Remote_Connection, Status, Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Warning_Msg);
Log.Put_Line ("Remote library for " & Import_Name &
" isn't on search list for " &
Naming.Get_Full_Name (Referencer),
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
end if;
end loop;
end Remove_All_Remote_Imports;
procedure Remove_Remote_Imports
(View_To_Remove : Directory.Object;
From_View : Directory.Object;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean) is
Imported_View : constant String :=
Naming.Get_Full_Name (View_To_Remove);
Import : Directory.Object;
Imported_Closure : constant View_Support.Unit_List :=
View_Support.Get_Imports (For_View => View_To_Remove,
Closure => True);
begin
if Trace_Command then
Log.Put_Line ("Remove_Remote_Imports (View_To_Remove" &
Qt (Imported_View) & ", From_View" &
Qt (Naming.Get_Full_Name (From_View)) & ")",
Profile.Sharp_Msg);
end if;
if Ss.Error (Imported_Closure.Condition) then
Log.Put_Line (Ss.Message (Imported_Closure.Condition),
Profile.Negative_Msg);
Set_Status
("Can't get import closure for view " & Imported_View, Status);
return;
end if;
-- Remove the specified view as a remote import of From_View.
Remove_Remote_Import (View_To_Remove => View_To_Remove,
From_View => From_View,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
Set_Status
("Can't remove remote import for " & Imported_View, Status);
return;
end if;
-- Now remove all of the specified view's imports as remote imports of
-- From_View and each of its referencers (unless they are required by
-- another of From_View's imports).
for Index in 1 .. Imported_Closure.Size loop
Import := Imported_Closure.Data (Index);
if Trace_Command then
Log.Put_Line (". Imported_Closure (" & Integer'Image (Index) &
") => " & Naming.Get_Full_Name (Import),
Profile.At_Msg);
end if;
if Import /= From_View and then Import /= View_To_Remove then
Remove_All_Remote_Imports
(View_To_Remove => Import,
From_View => From_View,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
Ss.Initialize (Status);
end if;
end if;
end loop;
exception
when others =>
Unhandled_Exception (Status, "Remove_Remote_Imports");
end Remove_Remote_Imports;
procedure Create_Remote_Directory (Remote_Directory : String;
Remote_Machine : String;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean := False) is
Remote_Connection : Rci.Context;
Local_Status : Ss.Condition;
Dir_Exists : Boolean := False;
Fil_Exists : Boolean := False;
Directory_Separator : constant String := "/";
Remote_Ada_Library : constant String := Remote_Directory & "/ada.lib";
Create_Dir_Command : constant String := "mkdir -p " & Remote_Directory;
Create_Ada_Lib_Command : constant String :=
Compiler_Location.The_Path_With & "a.mklib -t " &
Compiler_Location.Target_Name & " -f " &
Remote_Directory & "; cd " & Remote_Directory & "; " &
Compiler_Location.The_Additional_Commands & "; cd ..";
begin
if Trace_Command then
Log.Put_Line (Message =>
"Create_Remote_Directory (Remote_Directory" &
Qt (Remote_Directory) & ", Remote_Machine" &
Qt (Remote_Machine) & ")",
Kind => Profile.Sharp_Msg);
end if;
Log.Put_Line (Message =>
"Creating remote directory" & Qt (Remote_Directory),
Kind => Profile.Debug_Msg);
if Su.Locate (Directory_Separator, Remote_Directory) /= 1 then
Set_Status ("Remote_Directory string must begin with a """ &
Directory_Separator & """ character", Status);
return;
end if;
Rci.Acquire (Remote_Connection => Remote_Connection,
Status => Status,
Target_Key => Target_Key,
Remote_Machine => Remote_Machine,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
end if;
Set_Status
("Can't acquire connection to " & Remote_Machine, Status);
else
begin
-- See if the Ada library already exists in the remote
-- directory.
Rci.File_Exists (The_File => Remote_Ada_Library,
Remote_Connection => Remote_Connection,
Status => Status,
Exists => Fil_Exists,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status),
Profile.Negative_Msg);
end if;
Set_Status ("Can't tell whether Ada library """ &
Remote_Ada_Library & """ exists on machine """ &
Remote_Machine & """", Status);
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
return;
end if;
if Fil_Exists then
Log.Put_Line ("An Ada library already exists " &
"in remote directory """ &
Remote_Directory & """", Profile.Warning_Msg);
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
return;
end if;
-- The Ada library doesn't exist, so we will need to create it.
-- Does the remote directory exist?
Rci.File_Exists (The_File => Remote_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Exists => Dir_Exists,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status),
Profile.Negative_Msg);
end if;
Set_Status
("Can't tell whether directory """ & Remote_Directory &
""" exists on machine """ & Remote_Machine & """",
Status);
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
return;
end if;
if Dir_Exists then
-- The directory exists, but it is not an Ada library. We
-- will create an Ada library within it.
Log.Put_Line (Message => "Directory """ & Remote_Directory &
""" already exists",
Kind => Profile.Warning_Msg);
Log.Put_Line (Message => "Using an existing directory",
Kind => Profile.Note_Msg);
else
-- The directory doesn't exist, so we will create it and
-- then make it into an Ada library.
Log.Put_Line (Message =>
"Creating the new remote directory """ &
Remote_Directory & """",
Kind => Profile.Note_Msg);
if Trace_Command then
Log.Put_Line ("Create_Dir_Command" &
Qt (Create_Dir_Command), Profile.At_Msg);
end if;
Rci.Execute_Command (Command_Line => Create_Dir_Command,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status),
Profile.Negative_Msg);
end if;
Set_Status ("Can't create remote directory """ &
Remote_Directory & """", Status);
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
return;
end if;
end if;
if Trace_Command then
Log.Put_Line ("Set_the_VADS_PATH_on" &
Qt (Compiler_Location.The_Vads_Path_Without),
Profile.At_Msg);
Log.Put_Line ("Create_Ada_Lib_Command" &
Qt (Create_Ada_Lib_Command), Profile.At_Msg);
end if;
--[ Set the VADS_PATH on ]
Rci.Execute_Command
(Command_Line => Compiler_Location.The_Vads_Path_Without,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
Rci.Execute_Command (Command_Line => Create_Ada_Lib_Command,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status),
Profile.Negative_Msg);
end if;
Set_Status
("Can't create an Ada library in remote directory """ &
Remote_Directory & """", Status);
end if;
exception
when others =>
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
raise;
end;
end if;
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
exception
when others =>
Unhandled_Exception (Status, "Create_Remote_Directory");
end Create_Remote_Directory;
procedure Destroy_Remote_Library (For_View : Directory.Object;
Remote_Directory : String;
Remote_Machine : String;
Status : in out Simple_Status.Condition;
Trace_Command : Boolean := False) is
Remote_Connection : Rci.Context;
Dir_Exists : Boolean := True;
Local_Status : Ss.Condition;
Remote_Ada_Library : constant String := Remote_Directory & "/ada.lib";
Unprotect_Library_Command : constant String :=
"chmod -R 777 " & Remote_Directory;
Remove_Ada_Library_Command : constant String :=
Compiler_Location.The_Path_With & "a.rmlib -f " & Remote_Directory;
Destroy_Files_Command : constant String :=
"rm -f " & Remote_Directory & "/*";
Destroy_Options_File_Command : constant String :=
"rm -f " & Remote_Directory & "/.options*";
Remove_Directory_Command : constant String :=
"rmdir " & Remote_Directory;
begin
if Trace_Command then
Log.Put_Line
(Message => "Destroy_Remote_Library (Remote_Directory" &
Qt (Remote_Directory) &
", Remote_Machine" & Qt (Remote_Machine) & ")",
Kind => Profile.Sharp_Msg);
end if;
Log.Put_Line (Message =>
"Destroying Ada library in remote directory = " &
Remote_Directory,
Kind => Profile.Debug_Msg);
Rci.Acquire (Remote_Connection => Remote_Connection,
Status => Status,
Target_Key => Target_Key,
Remote_Machine => Remote_Machine,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
end if;
Set_Status
("Can't acquire connection to " & Remote_Machine, Status);
else
begin
Rci.File_Exists (The_File => Remote_Ada_Library,
Remote_Connection => Remote_Connection,
Status => Status,
Exists => Dir_Exists,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status),
Profile.Negative_Msg);
end if;
Set_Status
("Can't tell whether Ada library " &
"exists in directory """ & Remote_Directory &
""" on machine """ & Remote_Machine & """", Status);
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
return;
end if;
if not Dir_Exists then
Log.Put_Line (Message =>
"There is no remote Ada library " &
"in directory """ & Remote_Directory &
""" on machine " & Remote_Machine,
Kind => Profile.Negative_Msg);
Set_Status ("Can't destroy remote library",
Status, Ss.Problem);
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
return;
end if;
-- Remove Remote_Directory as an import from each of For_View's
-- referencers.
declare
Importer : Directory.Object;
Referencers : constant View_Support.Unit_List :=
View_Support.Get_Referencers (For_View, True);
begin
if Ss.Error (Referencers.Condition) then
if Trace_Command then
Log.Put_Line (Ss.Message (Referencers.Condition),
Profile.Negative_Msg);
end if;
Set_Status ("Can't get referencers for view " &
Naming.Get_Full_Name (For_View), Status);
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
return;
end if;
for Index in 1 .. Referencers.Size loop
Importer := Referencers.Data (Index);
if Trace_Command then
Log.Put_Line
(". Referencers (" & Integer'Image (Index) &
", " & Naming.Get_Full_Name (For_View) &
") => " & Naming.Get_Full_Name (Importer),
Profile.At_Msg);
end if;
if Importer /= For_View then
-- Remove For_View as a remote import of Importer.
-- Also remove as imports of Importer the views
-- that are imported by For_View which are not
-- otherwise needed by Importer. Remove the same
-- views, if they are not still needed, from each
-- referencer of Importer.
Remove_Remote_Imports
(View_To_Remove => For_View,
From_View => Importer,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status),
Profile.Warning_Msg);
Log.Put_Line ("Can't remove remote import " &
Remote_Directory & " from " &
Naming.Get_Full_Name (Importer),
Profile.Warning_Msg);
Ss.Initialize (Status);
end if;
end if;
end loop;
end;
if Trace_Command then
Log.Put_Line ("Executing command" &
Qt (Unprotect_Library_Command),
Profile.At_Msg);
end if;
Rci.Execute_Command (Command_Line => Unprotect_Library_Command,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status),
Profile.Negative_Msg);
end if;
Set_Status ("Can't unprotect " & Remote_Directory, Status);
else
if Trace_Command then
Log.Put_Line ("Executing command" &
Qt (Remove_Ada_Library_Command),
Profile.At_Msg);
end if;
Rci.Execute_Command
(Command_Line => Remove_Ada_Library_Command,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status),
Profile.Negative_Msg);
end if;
Set_Status ("Can't destroy the remote Ada library " &
Remote_Directory, Status);
else
if Trace_Command then
Log.Put_Line ("Executing command" &
Qt (Destroy_Files_Command),
Profile.At_Msg);
end if;
Rci.Execute_Command
(Command_Line => Destroy_Files_Command,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status),
Profile.Warning_Msg);
end if;
Set_Status ("Can't destroy the files in " &
"remote directory " & Remote_Directory,
Status, Ss.Warning);
else
if Trace_Command then
Log.Put_Line ("Executing command" &
Qt (Destroy_Options_File_Command),
Profile.At_Msg);
end if;
Rci.Execute_Command
(Command_Line => Destroy_Options_File_Command,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status),
Profile.Warning_Msg);
end if;
Set_Status
("Can't destroy the '.options' file in " &
"remote directory " & Remote_Directory,
Status, Ss.Warning);
else
if Trace_Command then
Log.Put_Line ("Executing command" &
Qt (Remove_Directory_Command),
Profile.At_Msg);
end if;
Rci.Execute_Command
(Command_Line => Remove_Directory_Command,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_Command);
if Ss.Error (Status) then
if Trace_Command then
Log.Put_Line (Ss.Message (Status),
Profile.Warning_Msg);
end if;
Set_Status
("Can't destroy the remote directory " &
Remote_Directory, Status, Ss.Warning);
end if;
end if;
end if;
end if;
end if;
exception
when others =>
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
raise;
end;
end if;
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_Command);
exception
when others =>
Unhandled_Exception (Status, "Destroy_Remote_Library");
end Destroy_Remote_Library;
end Extensions_Support;
nblk1=3d
nid=0
hdr6=7a
[0x00] rec0=24 rec1=00 rec2=01 rec3=048
[0x01] rec0=18 rec1=00 rec2=02 rec3=04a
[0x02] rec0=24 rec1=00 rec2=03 rec3=00a
[0x03] rec0=24 rec1=00 rec2=04 rec3=008
[0x04] rec0=18 rec1=00 rec2=05 rec3=046
[0x05] rec0=18 rec1=00 rec2=06 rec3=02a
[0x06] rec0=17 rec1=00 rec2=07 rec3=02e
[0x07] rec0=1b rec1=00 rec2=08 rec3=040
[0x08] rec0=18 rec1=00 rec2=09 rec3=002
[0x09] rec0=1b rec1=00 rec2=0a rec3=004
[0x0a] rec0=16 rec1=00 rec2=0b rec3=03a
[0x0b] rec0=1c rec1=00 rec2=0c rec3=004
[0x0c] rec0=1c rec1=00 rec2=0d rec3=00e
[0x0d] rec0=19 rec1=00 rec2=0e rec3=012
[0x0e] rec0=19 rec1=00 rec2=0f rec3=05a
[0x0f] rec0=1a rec1=00 rec2=10 rec3=016
[0x10] rec0=1c rec1=00 rec2=11 rec3=054
[0x11] rec0=18 rec1=00 rec2=12 rec3=048
[0x12] rec0=18 rec1=00 rec2=13 rec3=046
[0x13] rec0=1c rec1=00 rec2=14 rec3=00e
[0x14] rec0=16 rec1=00 rec2=15 rec3=028
[0x15] rec0=19 rec1=00 rec2=16 rec3=02c
[0x16] rec0=14 rec1=00 rec2=17 rec3=062
[0x17] rec0=14 rec1=00 rec2=18 rec3=056
[0x18] rec0=1e rec1=00 rec2=19 rec3=084
[0x19] rec0=1a rec1=00 rec2=1a rec3=01e
[0x1a] rec0=1c rec1=00 rec2=1b rec3=018
[0x1b] rec0=18 rec1=00 rec2=1c rec3=04e
[0x1c] rec0=1b rec1=00 rec2=1d rec3=076
[0x1d] rec0=1b rec1=00 rec2=1e rec3=010
[0x1e] rec0=17 rec1=00 rec2=1f rec3=044
[0x1f] rec0=19 rec1=00 rec2=20 rec3=010
[0x20] rec0=1a rec1=00 rec2=21 rec3=054
[0x21] rec0=16 rec1=00 rec2=22 rec3=014
[0x22] rec0=18 rec1=00 rec2=23 rec3=010
[0x23] rec0=1b rec1=00 rec2=24 rec3=040
[0x24] rec0=15 rec1=00 rec2=25 rec3=05e
[0x25] rec0=1e rec1=00 rec2=26 rec3=028
[0x26] rec0=15 rec1=00 rec2=27 rec3=02e
[0x27] rec0=1a rec1=00 rec2=28 rec3=050
[0x28] rec0=16 rec1=00 rec2=29 rec3=038
[0x29] rec0=15 rec1=00 rec2=2a rec3=034
[0x2a] rec0=14 rec1=00 rec2=2b rec3=052
[0x2b] rec0=14 rec1=00 rec2=2c rec3=05a
[0x2c] rec0=15 rec1=00 rec2=2d rec3=058
[0x2d] rec0=16 rec1=00 rec2=2e rec3=072
[0x2e] rec0=1a rec1=00 rec2=2f rec3=06a
[0x2f] rec0=1c rec1=00 rec2=30 rec3=05e
[0x30] rec0=1a rec1=00 rec2=31 rec3=012
[0x31] rec0=14 rec1=00 rec2=32 rec3=06a
[0x32] rec0=18 rec1=00 rec2=33 rec3=028
[0x33] rec0=14 rec1=00 rec2=34 rec3=02c
[0x34] rec0=12 rec1=00 rec2=35 rec3=006
[0x35] rec0=15 rec1=00 rec2=36 rec3=00e
[0x36] rec0=16 rec1=00 rec2=37 rec3=030
[0x37] rec0=16 rec1=00 rec2=38 rec3=050
[0x38] rec0=15 rec1=00 rec2=39 rec3=062
[0x39] rec0=14 rec1=00 rec2=3a rec3=006
[0x3a] rec0=12 rec1=00 rec2=3b rec3=070
[0x3b] rec0=18 rec1=00 rec2=3c rec3=054
[0x3c] rec0=09 rec1=00 rec2=3d rec3=000
tail 0x215497e4c87503f373270 0x42a00088462060003