|
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: 57344 (0xe000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Library_Extensions, seg_0142c9
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Debug_Tools;
with Directory;
with Io;
with Import_Interface;
with Library_Interface;
with Log;
with Object_Subclass;
with Profile;
with Rcf_Switch_Implementation;
with Remote_Command_Interface;
with String_Utilities;
package body Library_Extensions is
package Naming renames Directory.Naming;
Default_Host_List_File : constant String := "alib_list";
Default_Target_List_File : constant String := "alib.list";
Default_Program_Library : constant String := "working";
function Program_Library_Name
(Stripped_Program_Library : String) return String is
begin
if Stripped_Program_Library'Length = 0 then
return Default_Program_Library;
else
return Stripped_Program_Library;
end if;
end Program_Library_Name;
procedure Set_Status (Status : in out Simple_Status.Condition;
Error_Type : String := "Remote_Operation_Error";
Message : String;
Severity : Simple_Status.Condition_Class :=
Simple_Status.Problem) is
begin
Simple_Status.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 (Status => Status,
Error_Type => "Unhandled Exception",
Message => Debug_Tools.Get_Exception_Name &
" caught in " & Routine & ".");
end Unhandled_Exception;
procedure Set_Context (Old_Context : in out Naming.Context;
View : String;
Status : in out Simple_Status.Condition) is
Error_Status : Directory.Error_Status;
New_Context : Naming.Context;
Dir_Object : Directory.Object;
Name_Status : Naming.Name_Status;
begin
Naming.Resolve (Name => View,
The_Object => Dir_Object,
Status => Name_Status);
if not Naming."=" (Name_Status, Naming.Successful) then
Set_Status (Status => Status,
Message => "Unable to resolve" & View &
". " & "Name Status = " &
Naming.Name_Status'Image (Name_Status));
return;
end if;
-- Get the current naming context for Promote_Unit.
Naming.Get_Context (The_Context => New_Context,
The_Unit => Dir_Object,
Status => Error_Status);
if not Directory."=" (Error_Status, Directory.Successful) then
Set_Status (Status => Status,
Message => "Unable to get default context for " &
View & ". Error Status = " &
Directory.Error_Status'Image
(Error_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 not Directory."=" (Error_Status, Directory.Successful) then
Set_Status (Status => Status,
Message => "Unable to default context to " &
View & ". Error Status = " &
Directory.Error_Status'Image
(Error_Status));
return;
end if;
end Set_Context;
procedure Reset_Context (Old_Context : Directory.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);
end Reset_Context;
procedure Download_File (Host_File_Name : String;
Target_File_Name : String;
Remote_Directory : String;
Remote_Machine : String;
Status : in out Simple_Status.Condition) is
Remote_Connection : Remote_Command_Interface.Context;
Local_Status : Simple_Status.Condition;
Fully_Qualified_Target_Name : constant String :=
Remote_Directory & "/" & Target_File_Name;
begin
Log.Put_Line (Message => "Transferring " & Host_File_Name & " to " &
Fully_Qualified_Target_Name & ".",
Kind => Profile.Debug_Msg);
Remote_Command_Interface.Acquire
(Remote_Connection => Remote_Connection,
Target_Key => "Rs6000_Aix_Ibm",
Remote_Machine => Remote_Machine,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to acquire connection to " &
Remote_Machine);
return;
end if;
Remote_Command_Interface.Put
(Host_File_Name => Host_File_Name,
Target_File_Name => Fully_Qualified_Target_Name,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => False);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to transfer " & Host_File_Name &
" to " & Target_File_Name &
" on " & Remote_Machine);
end if;
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection, Status => Local_Status);
end Download_File;
procedure Upload_File (Host_File_Name : String;
Target_File_Name : String;
Remote_Directory : String;
Remote_Machine : String;
Status : in out Simple_Status.Condition) is
Remote_Connection : Remote_Command_Interface.Context;
Local_Status : Simple_Status.Condition;
Fully_Qualified_Target_Name : constant String :=
Remote_Directory & "/" & Target_File_Name;
begin
Log.Put_Line (Message => "Uploading " & Host_File_Name & " from " &
Fully_Qualified_Target_Name & ".",
Kind => Profile.Debug_Msg);
Remote_Command_Interface.Acquire
(Remote_Connection => Remote_Connection,
Target_Key => "Rs6000_Aix_Ibm",
Remote_Machine => Remote_Machine,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to acquire connection to " &
Remote_Machine);
return;
end if;
Remote_Command_Interface.Get
(Host_File_Name => Host_File_Name,
Target_File_Name => Fully_Qualified_Target_Name,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => False);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to upload " & Host_File_Name &
" to " & Target_File_Name &
" from " & Remote_Machine);
end if;
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection, Status => Local_Status);
end Upload_File;
procedure Build_List_File (Host_View : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
List_File_Name : String;
Status : in out Simple_Status.Condition) is
Dir_Object : Directory.Object;
Name_Status : Naming.Name_Status;
Local_Status : Simple_Status.Condition;
List_File : Io.File_Type;
begin
Log.Put_Line (Message =>
"Building list file for Host_View = " &
Host_View & ", and target library = " &
Remote_Directory & "/" & Remote_Program_Library,
Kind => Profile.Debug_Msg);
if Host_View = "" then
Set_Status
(Status => Status,
Message => "A null Host_View was supplied to " &
"Remote_Library_Integration.Build_List_File");
return;
end if;
Naming.Resolve (Name => List_File_Name,
The_Object => Dir_Object,
Status => Name_Status);
case Name_Status is
when Naming.Successful =>
Io.Open (File => List_File, Name => List_File_Name);
when Naming.Undefined =>
Io.Create (File => List_File, Name => List_File_Name);
-- do I need to open it here
when others =>
Set_Status (Status => Status,
Message => "Unable to resolve " &
List_File_Name & ". Status =" &
Naming.Name_Status'Image
(Name_Status));
return;
end case;
Io.Put_Line (File => List_File, Item => "-- Host_View => " & Host_View);
if Remote_Program_Library = "" then
Io.Put_Line (File => List_File, Item => Default_Program_Library);
else
Io.Put_Line (File => List_File, Item => Remote_Program_Library);
end if;
-- Add Imports Later !
Io.Put_Line (List_File, "/usr/lpp/ada/lib/libada");
Io.Close (List_File);
exception
when others =>
Unhandled_Exception (Status, "Build_List_File");
begin
Io.Close (List_File);
exception
when others =>
null;
end;
end Build_List_File;
procedure Create_Remote_Directory
(Remote_Directory : String;
Remote_Machine : String;
Status : in out Simple_Status.Condition) is
Remote_Connection : Remote_Command_Interface.Context;
Local_Status : Simple_Status.Condition;
Create_Dir_Command : constant String := "mkdir " & Remote_Directory;
begin
Log.Put_Line (Message =>
"Creating remote directory = " & Remote_Directory,
Kind => Profile.Debug_Msg);
Remote_Command_Interface.Acquire
(Remote_Connection => Remote_Connection,
Target_Key => "Rs6000_Aix_Ibm",
Remote_Machine => Remote_Machine,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to acquire connection to " &
Remote_Machine);
return;
end if;
Remote_Command_Interface.Execute_Command
(Command_Line => Create_Dir_Command,
Remote_Connection => Remote_Connection,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to create the remote directory, " &
Remote_Directory & ".");
end if;
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection, Status => Local_Status);
exception
when others =>
Unhandled_Exception (Status, "Create_Remote_Directory");
begin
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection,
Status => Local_Status);
exception
when others =>
null;
end;
end Create_Remote_Directory;
procedure Create_Program_Library
(Host_View : String;
Remote_Directory : String;
Remote_Program_Library : String;
Remote_Machine : String;
Status : in out Simple_Status.Condition) is
Remote_Connection : Remote_Command_Interface.Context;
Local_Status : Simple_Status.Condition;
Build_Library_Command : constant String :=
"PATH=$PATH:/usr/bin/ada ; export PATH ; /usr/bin/ada/alibinit -p 100000 -L " &
Remote_Directory & "/alib.list";
List_File_Name : constant String :=
Host_View & ".State.Tool_State." & Default_Host_List_File;
begin
Log.Put_Line (Message => "Creating remote program library = " &
Remote_Program_Library,
Kind => Profile.Debug_Msg);
Build_List_File (Host_View => Host_View,
Remote_Directory => Remote_Directory,
Remote_Machine => Remote_Machine,
Remote_Program_Library => Remote_Program_Library,
List_File_Name => List_File_Name,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status
(Status => Status,
Message => "Unable to create the remote library list file.");
return;
else
Download_File (Host_File_Name => List_File_Name,
Target_File_Name => Default_Target_List_File,
Remote_Directory => Remote_Directory,
Remote_Machine => Remote_Machine,
Status => Status);
end if;
Remote_Command_Interface.Acquire
(Remote_Connection => Remote_Connection,
Target_Key => "Rs6000_Aix_Ibm",
Set_Directory => "cd " & Remote_Directory,
Remote_Machine => Remote_Machine,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to acquire connection to " &
Remote_Machine);
return;
end if;
Remote_Command_Interface.Execute_Command
(Command_Line => Build_Library_Command,
Remote_Connection => Remote_Connection,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status
(Status => Status,
Message => "Unable to create the remote program library, " &
Remote_Program_Library & ".");
end if;
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection, Status => Local_Status);
exception
when others =>
Unhandled_Exception (Status, "Create_Program_Library");
begin
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection,
Status => Local_Status);
exception
when others =>
null;
end;
end Create_Program_Library;
procedure Destroy_Remote_Library
(Remote_Directory : String;
Remote_Machine : String;
Status : in out Simple_Status.Condition) is
Remote_Connection : Remote_Command_Interface.Context;
Local_Status : Simple_Status.Condition;
Destroy_Library_Command : constant String :=
"rm -r " & Remote_Directory;
begin
Log.Put_Line (Message =>
"Destroying Remote Directory = " & Remote_Directory,
Kind => Profile.Debug_Msg);
Remote_Command_Interface.Acquire
(Remote_Connection => Remote_Connection,
Target_Key => "Rs6000_Aix_Ibm",
Set_Directory => "cd " & Remote_Directory & "/..",
Remote_Machine => Remote_Machine,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to acquire connection to " &
Remote_Machine);
return;
end if;
Remote_Command_Interface.Execute_Command
(Command_Line => Destroy_Library_Command,
Remote_Connection => Remote_Connection,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status
(Status => Status,
Message => "Unable to destroy the remote directory/library, " &
Remote_Directory & ".");
end if;
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection, Status => Local_Status);
exception
when others =>
Unhandled_Exception (Status, "Destroy_Remote_Library");
begin
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection,
Status => Local_Status);
exception
when others =>
null;
end;
end Destroy_Remote_Library;
procedure File_Exists (Remote_Filename : String;
Remote_Machine : String;
Status : in out Simple_Status.Condition;
Exists : out Boolean) is
Remote_Connection : Remote_Command_Interface.Context;
begin
Exists := False;
Remote_Command_Interface.Acquire
(Remote_Connection => Remote_Connection,
Status => Status,
Target_Key => "Rs6000_Aix_Ibm",
Remote_Machine => Remote_Machine);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to acquire connection to " &
Remote_Machine);
return;
end if;
Remote_Command_Interface.File_Exists
(The_File => Remote_Filename,
Remote_Connection => Remote_Connection,
Status => Status,
Exists => Exists);
exception
when others =>
Unhandled_Exception (Status, "File_Exists");
end File_Exists;
procedure Directory_Exists (Remote_Machine : String;
Remote_Directory : String;
Status : in out Simple_Status.Condition;
Exists : out Boolean) is
begin
File_Exists (Remote_Filename => Remote_Directory,
Remote_Machine => Remote_Machine,
Status => Status,
Exists => Exists);
exception
when others =>
Unhandled_Exception (Status, "Directory_Exists");
end Directory_Exists;
procedure Refresh_Imports (Host_View : String;
Host_List_File : String;
Remote_Directory : String;
Remote_Machine : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
Dir_Object : Directory.Object;
Name_Status : Naming.Name_Status;
Local_Status : Simple_Status.Condition;
List_File : Io.File_Type;
Imports : Import_Interface.Import_Iterator;
begin
Log.Put_Line (Message =>
"Refreshing imports for target library = " &
Remote_Directory & "/" & Remote_Program_Library,
Kind => Profile.Debug_Msg);
if Host_View = "" then
Set_Status (Status => Status,
Message => "A null Host_View was supplied to " &
"Remote_Library_Integration.Refresh_Imports");
return;
end if;
Naming.Resolve (Name => Host_List_File,
The_Object => Dir_Object,
Status => Name_Status);
case Name_Status is
when Naming.Successful =>
Io.Open (File => List_File, Name => Host_List_File);
when Naming.Undefined =>
Io.Create (File => List_File, Name => Host_List_File);
-- do I need to open it here
when others =>
Set_Status (Status => Status,
Message => "Unable to resolve " &
Host_List_File & ". Status =" &
Naming.Name_Status'Image
(Name_Status));
return;
end case;
Import_Interface.Get_Remote_Imports (For_View => Host_View,
Closure => True,
Imports => Imports,
Condition => Status);
-- Add From View Comment and local working library
Io.Put_Line (File => List_File, Item => "-- Host_View => " & Host_View);
if Remote_Program_Library = "" then
Io.Put_Line (File => List_File, Item => Default_Program_Library);
else
Io.Put_Line (File => List_File, Item => Remote_Program_Library);
end if;
while not Import_Interface.Done (Imports) loop
declare
Next_Import : constant String :=
Import_Interface.Value (Imports);
Local_Library : constant String :=
Remote_Directory & "/" & Remote_Program_Library;
begin
if not String_Utilities.Equal (Str1 => Next_Import,
Str2 => Local_Library,
Ignore_Case => True) then
if Next_Import (Next_Import'Last) = '/' then
Io.Put_Line (List_File, Next_Import &
Default_Program_Library);
else
Io.Put_Line (List_File, Next_Import);
end if;
end if;
Import_Interface.Next (Imports);
end;
end loop;
-- Add predefined
Io.Put_Line (List_File, "/usr/lpp/ada/lib/libada");
Io.Close (List_File);
end Refresh_Imports;
procedure Update_Import_List (Host_View : String;
Remote_Directory : String;
Remote_Machine : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
Host_List_File : constant String :=
Host_View & ".State.Tool_State." & Default_Host_List_File;
Target_List_File : constant String :=
Remote_Directory & "/" & Default_Target_List_File;
begin
null;
-- Upload_File (Host_File_Name => Host_List_File,
-- Target_File_Name => Target_List_File,
-- Remote_Directory => Remote_Directory,
-- Remote_Machine => Remote_Machine,
-- Status => Status);
end Update_Import_List;
function Is_View (Obj : Directory.Object) return Boolean is
Subclass : Directory.Subclass := Directory.Get_Subclass (Obj);
use Directory; -- for operators
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
N_Status : Naming.Name_Status;
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 (Message => Object_Name & " does not exist",
Kind => Profile.Warning_Msg);
return Directory.Nil;
end if;
return Get_View (Obj);
end Get_View;
procedure Make_Path_Preprocess (Host_Path_Name : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
Remote_Connection : Remote_Command_Interface.Context;
Set_Path_Command : constant String :=
"PATH=$PATH:/usr/bin/ada; export PATH";
begin
if Rcf_Switch_Implementation.Is_Host_Only
(Get_View (Host_Path_Name)) then
Log.Put_Line (Message =>
"Not executing Make_Path_Preprocess. " &
Host_Path_Name & " is a Host_Only View. ",
Kind => Profile.Note_Msg);
Simple_Status.Initialize (Status);
return;
else
Log.Put_Line (Message => "Executing Make_Path_Preprocess",
Kind => Profile.Note_Msg);
end if;
Remote_Command_Interface.Acquire
(Remote_Connection => Remote_Connection,
Status => Status,
Target_Key => "Rs6000_Aix_Ibm",
Remote_Machine => Remote_Machine);
Remote_Command_Interface.Execute_Command
(Command_Line => Set_Path_Command,
Remote_Connection => Remote_Connection,
Status => Status);
-- set context
Simple_Status.Initialize (Status);
-- reset context
exception
when others =>
Unhandled_Exception (Status, "Make_Path_Preprocess");
end Make_Path_Preprocess;
procedure Make_Path_Postprocess (Host_Path_Name : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
Stripped_Machine : constant String :=
String_Utilities.Strip (From => Remote_Machine, Filler => ' ');
Stripped_Directory : constant String :=
String_Utilities.Strip (From => Remote_Directory, Filler => ' ');
Stripped_Program_Library : constant String :=
String_Utilities.Strip
(From => Remote_Program_Library, Filler => ' ');
Dir_Exists : Boolean := False;
Fil_Exists : Boolean := False;
Old_Context : Directory.Naming.Context;
procedure Display_Information is
begin
if Stripped_Machine = "" then
Log.Put_Line (Message =>
"A null remote machine name was provided.",
Kind => Profile.Warning_Msg);
end if;
if Stripped_Directory = "" then
Log.Put_Line (Message =>
"A null remote directory name was provided.",
Kind => Profile.Warning_Msg);
end if;
end Display_Information;
begin
if Rcf_Switch_Implementation.Is_Host_Only
(Get_View (Host_Path_Name)) then
Log.Put_Line (Message =>
"Not executing Make_Path_Postprocess. " &
Host_Path_Name & " is a Host_Only View. ",
Kind => Profile.Note_Msg);
Simple_Status.Initialize (Status);
return;
else
Log.Put_Line (Message => "Executing Make_Path_Postprocess",
Kind => Profile.Note_Msg);
end if;
if Stripped_Machine = "" or else Stripped_Directory = "" then
Display_Information;
Set_Status
(Status => Status,
Message =>
"Insufficient remote machine or directory information.",
Severity => Simple_Status.Problem);
return;
end if;
Set_Context (Old_Context => Old_Context,
View => Host_Path_Name,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Make_Path_Postprocess Failed");
return;
end if;
Directory_Exists (Remote_Directory => Stripped_Directory,
Remote_Machine => Remote_Machine,
Status => Status,
Exists => Dir_Exists);
if Dir_Exists then
Log.Put_Line (Message => "Directory " & Stripped_Directory &
" already exists.",
Kind => Profile.Warning_Msg);
Log.Put_Line (Message => "Using an existing directory.",
Kind => Profile.Note_Msg);
else
Log.Put_Line (Message => "Creating a new remote directory," &
Stripped_Directory,
Kind => Profile.Note_Msg);
Create_Remote_Directory (Remote_Machine => Stripped_Machine,
Remote_Directory => Stripped_Directory,
Status => Status);
if Simple_Status.Error (Status) then
return;
end if;
end if;
File_Exists (Remote_Filename =>
Stripped_Directory & "/" & Default_Target_List_File,
Remote_Machine => Remote_Machine,
Status => Status,
Exists => Fil_Exists);
declare
Library_Name : constant String :=
Program_Library_Name (Stripped_Program_Library);
begin
Directory_Exists (Remote_Directory =>
Stripped_Directory & "/" & Library_Name,
Remote_Machine => Remote_Machine,
Status => Status,
Exists => Dir_Exists);
if Dir_Exists or else Fil_Exists then
Log.Put_Line (Message =>
"A program library already exists in " &
Stripped_Directory & ".",
Kind => Profile.Warning_Msg);
Log.Put_Line (Message =>
"The existing program library will be used.",
Kind => Profile.Warning_Msg);
return;
else
Log.Put_Line (Message =>
"Creating a new remote program library, " &
Stripped_Directory &
"/" & Library_Name & ".",
Kind => Profile.Note_Msg);
Create_Program_Library (Host_View => Host_Path_Name,
Remote_Machine => Stripped_Machine,
Remote_Program_Library => Library_Name,
Remote_Directory => Stripped_Directory,
Status => Status);
if Simple_Status.Error (Status) then
Set_Status
(Status => Status,
Message => "Unable to build remote program library " &
Library_Name & ".");
end if;
end if;
end;
Reset_Context (Old_Context);
exception
when others =>
Unhandled_Exception (Status, "Make_Path_Postprocess");
Reset_Context (Old_Context);
end Make_Path_Postprocess;
procedure Destroy_View_Preprocess
(Host_Path_Name : String;
Status : in out Simple_Status.Condition) is
Machine_Result : constant Library_Interface.String_Result :=
Library_Interface.Remote_Machine (View => Host_Path_Name);
Directory_Result : constant Library_Interface.String_Result :=
Library_Interface.Remote_Directory (View => Host_Path_Name);
Library_Result : constant Library_Interface.String_Result :=
Library_Interface.Remote_Library (View => Host_Path_Name);
Remote_Machine : constant String :=
Machine_Result.Result (1 .. Machine_Result.Size);
Remote_Directory : constant String :=
Directory_Result.Result (1 .. Directory_Result.Size);
Remote_Library : constant String :=
Library_Result.Result (1 .. Library_Result.Size);
Old_Context : Directory.Naming.Context;
Dir_Exists : Boolean := True;
procedure Display_Information is
begin
if Remote_Machine = "" then
Log.Put_Line (Message =>
"A null remote machine name was provided.",
Kind => Profile.Warning_Msg);
end if;
if Remote_Directory = "" then
Log.Put_Line (Message =>
"A null remote directory name was provided.",
Kind => Profile.Warning_Msg);
end if;
end Display_Information;
begin
if Rcf_Switch_Implementation.Is_Host_Only
(Get_View (Host_Path_Name)) then
Log.Put_Line (Message =>
"Not executing Destroy_View_Preprocess. " &
Host_Path_Name & " is a Host_Only View. ",
Kind => Profile.Note_Msg);
Simple_Status.Initialize (Status);
return;
else
Log.Put_Line (Message => "Executing Destroy_View_Preprocess",
Kind => Profile.Note_Msg);
end if;
Set_Context (Old_Context => Old_Context, View => Host_Path_Name,
Status => Status);
if Remote_Machine = "" or else Remote_Directory = "" then
Display_Information;
Set_Status (Status => Status,
Message => "Insufficient remote library information.",
Severity => Simple_Status.Problem);
return;
end if;
Directory_Exists (Remote_Directory => Remote_Directory,
Remote_Machine => Remote_Machine,
Status => Status,
Exists => Dir_Exists);
if Dir_Exists then
Destroy_Remote_Library (Remote_Directory => Remote_Directory,
Remote_Machine => Remote_Machine,
Status => Status);
else
Log.Put_Line (Message =>
"The remote directory, " & Remote_Directory &
" does not exist on machine, " & Remote_Machine,
Kind => Profile.Negative_Msg);
Set_Status
(Status => Status,
Message =>
"Unable to destroy remote directory/program library.",
Severity => Simple_Status.Problem);
end if;
Reset_Context (Old_Context);
exception
when others =>
Unhandled_Exception (Status, "Destroy_View_Preprocess");
end Destroy_View_Preprocess;
procedure Destroy_View_Postprocess
(Host_Path_Name : String;
Status : in out Simple_Status.Condition) is
begin
if Rcf_Switch_Implementation.Is_Host_Only
(Get_View (Host_Path_Name)) then
Log.Put_Line (Message =>
"Not executing Destroy_View_Postprocess. " &
Host_Path_Name & " is a Host_Only View. ",
Kind => Profile.Note_Msg);
Simple_Status.Initialize (Status);
return;
else
Log.Put_Line (Message => "Executing Destroy_View_Postprocess",
Kind => Profile.Note_Msg);
end if;
Simple_Status.Initialize (Status);
exception
when others =>
Unhandled_Exception (Status, "Destroy_View_Postprocess");
end Destroy_View_Postprocess;
procedure Update_Remote_Imports (Host_View : String;
List_File_Name : String;
Remote_Directory : String;
Remote_Machine : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
begin
Refresh_Imports (Host_View => Host_View,
Host_List_File => List_File_Name,
Remote_Directory => Remote_Directory,
Remote_Machine => Remote_Machine,
Remote_Program_Library => Remote_Program_Library,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => "Unable to update remote imports.",
Kind => Profile.Negative_Msg);
return;
end if;
Download_File (Host_File_Name => List_File_Name,
Target_File_Name => Default_Target_List_File,
Remote_Directory => Remote_Directory,
Remote_Machine => Remote_Machine,
Status => Status);
end Update_Remote_Imports;
procedure Import_Postprocess (Views_To_Import : Directory.Naming.Iterator;
Into_View : String;
Status : in out Simple_Status.Condition) is
Machine_Result : constant Library_Interface.String_Result :=
Library_Interface.Remote_Machine (View => Into_View);
Directory_Result : constant Library_Interface.String_Result :=
Library_Interface.Remote_Directory (View => Into_View);
Library_Result : constant Library_Interface.String_Result :=
Library_Interface.Remote_Library (View => Into_View);
Remote_Machine : constant String :=
Machine_Result.Result (1 .. Machine_Result.Size);
Remote_Directory : constant String :=
Directory_Result.Result (1 .. Directory_Result.Size);
Remote_Library : constant String :=
Library_Result.Result (1 .. Library_Result.Size);
Host_List_File : constant String :=
Into_View & ".State.Tool_State." & Default_Host_List_File;
Old_Context : Directory.Naming.Context;
procedure Display_Information is
begin
if Remote_Machine = "" then
Log.Put_Line (Message =>
"A null remote machine name was provided.",
Kind => Profile.Warning_Msg);
end if;
if Remote_Directory = "" then
Log.Put_Line (Message =>
"A null remote directory name was provided.",
Kind => Profile.Warning_Msg);
end if;
end Display_Information;
begin
if Rcf_Switch_Implementation.Is_Host_Only (Get_View (Into_View)) then
Log.Put_Line (Message => "Not executing Import_Postprocess. " &
Into_View & " is a Host_Only View. ",
Kind => Profile.Note_Msg);
Simple_Status.Initialize (Status);
return;
else
Log.Put_Line (Message => "Executing Import_Postprocess",
Kind => Profile.Note_Msg);
end if;
if Remote_Machine = "" or else Remote_Directory = "" then
Display_Information;
Set_Status
(Status => Status,
Message => "Insufficient remote program library information.",
Severity => Simple_Status.Problem);
return;
end if;
Set_Context (Old_Context => Old_Context,
View => Into_View,
Status => Status);
Update_Remote_Imports (Host_View => Into_View,
List_File_Name => Host_List_File,
Remote_Directory => Remote_Directory,
Remote_Machine => Remote_Machine,
Remote_Program_Library => Remote_Library,
Status => Status);
Reset_Context (Old_Context);
exception
when others =>
Unhandled_Exception (Status, "Import_Postprocess");
Reset_Context (Old_Context);
end Import_Postprocess;
procedure Import_Preprocess (Views_To_Import : Directory.Naming.Iterator;
Into_View : String;
Status : in out Simple_Status.Condition) is
begin
if Rcf_Switch_Implementation.Is_Host_Only (Get_View (Into_View)) then
Log.Put_Line (Message => "Not executing Import_Preprocess. " &
Into_View & " is a Host_Only View. ",
Kind => Profile.Note_Msg);
Simple_Status.Initialize (Status);
return;
else
Log.Put_Line (Message => "Executing Import_Preprocess",
Kind => Profile.Note_Msg);
end if;
-- set context
Simple_Status.Initialize (Status);
-- reset context
exception
when others =>
Unhandled_Exception (Status, "Import_Preprocess");
end Import_Preprocess;
procedure Remove_Import_Preprocess
(View_To_Remove : Directory.Object;
From_View : String;
Status : in out Simple_Status.Condition) is
begin
if Rcf_Switch_Implementation.Is_Host_Only (Get_View (From_View)) then
Log.Put_Line (Message =>
"Not executing Remove_Import_Preprocess. " &
From_View & " is a Host_Only View. ",
Kind => Profile.Note_Msg);
Simple_Status.Initialize (Status);
return;
else
Log.Put_Line (Message => "Executing Remove_Import_Preprocess",
Kind => Profile.Note_Msg);
end if;
-- set context
Simple_Status.Initialize (Status);
-- reset context
exception
when others =>
Unhandled_Exception (Status, "Remove_Import_Preprocess");
end Remove_Import_Preprocess;
procedure Remove_Import_Postprocess
(View_To_Remove : Directory.Object;
From_View : String;
Status : in out Simple_Status.Condition) is
Machine_Result : constant Library_Interface.String_Result :=
Library_Interface.Remote_Machine (View => From_View);
Directory_Result : constant Library_Interface.String_Result :=
Library_Interface.Remote_Directory (View => From_View);
Library_Result : constant Library_Interface.String_Result :=
Library_Interface.Remote_Library (View => From_View);
Remote_Machine : constant String :=
Machine_Result.Result (1 .. Machine_Result.Size);
Remote_Directory : constant String :=
Directory_Result.Result (1 .. Directory_Result.Size);
Remote_Library : constant String :=
Library_Result.Result (1 .. Library_Result.Size);
Host_List_File : constant String :=
From_View & ".State.Tool_State." & Default_Host_List_File;
Old_Context : Directory.Naming.Context;
begin
if Rcf_Switch_Implementation.Is_Host_Only (Get_View (From_View)) then
Log.Put_Line (Message =>
"Not executing Remove_Import_Postprocess. " &
From_View & " is a Host_Only View. ",
Kind => Profile.Note_Msg);
Simple_Status.Initialize (Status);
return;
else
Log.Put_Line (Message => "Executing Remove_Import_Postprocess",
Kind => Profile.Note_Msg);
end if;
Set_Context (Old_Context => Old_Context,
View => From_View,
Status => Status);
Update_Remote_Imports (Host_View => From_View,
List_File_Name => Host_List_File,
Remote_Directory => Remote_Directory,
Remote_Machine => Remote_Machine,
Remote_Program_Library => Remote_Library,
Status => Status);
Reset_Context (Old_Context);
exception
when others =>
Unhandled_Exception (Status, "Remove_Import_Postprocess");
end Remove_Import_Postprocess;
procedure Release_Preprocess (From_Working_View : String;
Released_View : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
begin
if Rcf_Switch_Implementation.Is_Host_Only
(Get_View (Released_View)) then
Log.Put_Line (Message =>
"Not executing Release_Preprocess. " &
Released_View & " is a Host_Only View. ",
Kind => Profile.Note_Msg);
Simple_Status.Initialize (Status);
return;
else
Log.Put_Line (Message => "Executing Release_Preprocess",
Kind => Profile.Note_Msg);
end if;
Make_Path_Preprocess (Host_Path_Name => Released_View,
Remote_Machine => Remote_Machine,
Remote_Directory => Remote_Directory,
Remote_Program_Library => Remote_Program_Library,
Status => Status);
exception
when others =>
Unhandled_Exception (Status, "Release_Preprocess");
end Release_Preprocess;
procedure Release_Postprocess (View_To_Remove : String;
Released_View : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
begin
if Rcf_Switch_Implementation.Is_Host_Only
(Get_View (Released_View)) then
Log.Put_Line (Message =>
"Not executing Release_Postprocess. " &
Released_View & " is a Host_Only View. ",
Kind => Profile.Note_Msg);
Simple_Status.Initialize (Status);
return;
else
Log.Put_Line (Message => "Executing Release_Postprocess",
Kind => Profile.Note_Msg);
end if;
Make_Path_Postprocess (Host_Path_Name => Released_View,
Remote_Machine => Remote_Machine,
Remote_Directory => Remote_Directory,
Remote_Program_Library => Remote_Program_Library,
Status => Status);
exception
when others =>
Unhandled_Exception (Status, "Release_Postprocess");
end Release_Postprocess;
procedure Link_Preprocess (Main_Unit : String;
Executable_Name : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line (Message => "Executing Link_Preprocess",
Kind => Profile.Note_Msg);
-- set context
Simple_Status.Initialize (Status);
-- reset context
exception
when others =>
Unhandled_Exception (Status, "Link_Preprocess");
end Link_Preprocess;
procedure Link_Postprocess (Main_Unit : String;
Executable_Name : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line (Message => "Executing Link_Postprocess",
Kind => Profile.Note_Msg);
-- set context
Simple_Status.Initialize (Status);
-- reset context
exception
when others =>
Unhandled_Exception (Status, "Link_Postprocess");
end Link_Postprocess;
end Library_Extensions;
nblk1=37
nid=0
hdr6=6e
[0x00] rec0=22 rec1=00 rec2=01 rec3=008
[0x01] rec0=15 rec1=00 rec2=02 rec3=05a
[0x02] rec0=18 rec1=00 rec2=03 rec3=068
[0x03] rec0=15 rec1=00 rec2=04 rec3=064
[0x04] rec0=19 rec1=00 rec2=05 rec3=034
[0x05] rec0=1a rec1=00 rec2=06 rec3=04e
[0x06] rec0=19 rec1=00 rec2=07 rec3=04c
[0x07] rec0=16 rec1=00 rec2=08 rec3=03c
[0x08] rec0=1c rec1=00 rec2=09 rec3=008
[0x09] rec0=18 rec1=00 rec2=0a rec3=040
[0x0a] rec0=18 rec1=00 rec2=0b rec3=00e
[0x0b] rec0=1d rec1=00 rec2=0c rec3=008
[0x0c] rec0=1a rec1=00 rec2=0d rec3=038
[0x0d] rec0=1b rec1=00 rec2=0e rec3=012
[0x0e] rec0=19 rec1=00 rec2=0f rec3=04a
[0x0f] rec0=15 rec1=00 rec2=10 rec3=01e
[0x10] rec0=1c rec1=00 rec2=11 rec3=01c
[0x11] rec0=1c rec1=00 rec2=12 rec3=06c
[0x12] rec0=1a rec1=00 rec2=13 rec3=01a
[0x13] rec0=1d rec1=00 rec2=14 rec3=028
[0x14] rec0=19 rec1=00 rec2=15 rec3=052
[0x15] rec0=1e rec1=00 rec2=16 rec3=01c
[0x16] rec0=17 rec1=00 rec2=17 rec3=002
[0x17] rec0=15 rec1=00 rec2=18 rec3=068
[0x18] rec0=18 rec1=00 rec2=19 rec3=06a
[0x19] rec0=18 rec1=00 rec2=1a rec3=04a
[0x1a] rec0=17 rec1=00 rec2=1b rec3=06a
[0x1b] rec0=21 rec1=00 rec2=1c rec3=012
[0x1c] rec0=16 rec1=00 rec2=1d rec3=046
[0x1d] rec0=1a rec1=00 rec2=1e rec3=028
[0x1e] rec0=17 rec1=00 rec2=1f rec3=076
[0x1f] rec0=1d rec1=00 rec2=20 rec3=044
[0x20] rec0=1d rec1=00 rec2=21 rec3=048
[0x21] rec0=18 rec1=00 rec2=22 rec3=050
[0x22] rec0=1a rec1=00 rec2=23 rec3=002
[0x23] rec0=13 rec1=00 rec2=24 rec3=036
[0x24] rec0=19 rec1=00 rec2=25 rec3=02e
[0x25] rec0=16 rec1=00 rec2=26 rec3=028
[0x26] rec0=1c rec1=00 rec2=27 rec3=002
[0x27] rec0=18 rec1=00 rec2=28 rec3=08e
[0x28] rec0=1e rec1=00 rec2=29 rec3=050
[0x29] rec0=19 rec1=00 rec2=2a rec3=016
[0x2a] rec0=15 rec1=00 rec2=2b rec3=02c
[0x2b] rec0=16 rec1=00 rec2=2c rec3=02c
[0x2c] rec0=1a rec1=00 rec2=2d rec3=04a
[0x2d] rec0=19 rec1=00 rec2=2e rec3=040
[0x2e] rec0=1b rec1=00 rec2=2f rec3=04c
[0x2f] rec0=1c rec1=00 rec2=30 rec3=048
[0x30] rec0=18 rec1=00 rec2=31 rec3=052
[0x31] rec0=18 rec1=00 rec2=32 rec3=046
[0x32] rec0=19 rec1=00 rec2=33 rec3=008
[0x33] rec0=16 rec1=00 rec2=34 rec3=004
[0x34] rec0=17 rec1=00 rec2=35 rec3=012
[0x35] rec0=18 rec1=00 rec2=36 rec3=00e
[0x36] rec0=11 rec1=00 rec2=37 rec3=000
tail 0x2170fc568831345667862 0x42a00088462060003