|
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 - metrics - download
Length: 8442 (0x20fa)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦263ff176c⟧
└─⟦this⟧
procedure Initialize_Dtia;with Program;
with Debug_Tools;
with Simple_Status;
with Error_Reporting;
procedure Initialize_Dtia is
package Dt renames Debug_Tools;
package Ss renames Simple_Status;
Activity : constant String := "!Machine.Release.Current.Activity";
Subsystem : constant String := "!Tools.Dtia_Rpc_Mechanisms";
Elaboration : constant String := "Elaboration";
Caller : constant String := "!Machine.Initialize_Dtia";
Job_Id : Program.Job_Id;
Status : Program.Condition;
function Elaboration_Command return String is
begin
return Program.Current (Subsystem => Subsystem,
Unit => Elaboration,
Activity => Activity);
end Elaboration_Command;
begin
declare
Command : constant String := Elaboration_Command;
begin
if Command'Length > 0 then
Program.Create_Job (Elaboration_Command,
Job => Job_Id,
Status => Status);
end if;
end;
if not Program.Started_Successfully (Status) then
Error_Reporting.Report_Error
(Caller => Caller,
Reason => Error_Reporting.Create_Condition_Name
("Unable to initialize Dtia", Error_Reporting.Problem),
Explanation => Ss.Display_Message (Status));
end if;
exception
when others =>
Error_Reporting.Report_Error
(Caller => Caller,
Reason => Error_Reporting.Create_Condition_Name
("UNHANDLED EXCEPTION", Error_Reporting.Problem),
Explanation => Dt.Get_Exception_Name (True, True));
end Initialize_Dtia;procedure Initialize_Rcf (Target_File_Name : String := "!Machine.Rcf_Targets");
-- Elaborates the RCF by running Start_Rcf_Main.
--
-- Once the RCF has been successfully elaborated, each of the Targets
-- entered in "!Machine.Rcf_Targets" is registered.
--
-- Each entry in "!Machine.Rcf_Targets" must be a valid RCF target key name.
-- For a Target_Key to be considered valid, a customization must exist in
-- "!Targets.Implementation.Rcf_Customization."Target_Key"'View".
--
-- For example, an entry of "Rs6000_Aix_Ibm" in "!Machine.Rcf_Targets"
-- would have to be accompanied by a subsystem with the following name:
-- "!Targets.Implementation.Rcf_Customization.Rs6000_Aix_Ibm"
-- In this subsystem could be any number of load views, the most current
-- of which must reside in the machine's default activity. In this
-- view should be a valid customization as described in Rational Remote
-- Compilation Facility Customizers Guide.with Debug_Tools;
with Directory_Tools;
with Error_Reporting;
with Io;
with Log;
with Error_Reporting;
with Profile;
with Program;
with Simple_Status;
with String_Utilities;
with System_Utilities;
procedure Initialize_Rcf (Target_File_Name : String :=
"!Machine.Rcf_Targets") is
Target_File : Io.File_Type;
Register_Context : constant String :=
"!Targets.Implementation.Rcf_Customization";
Job : Program.Job_Id;
Condition : Program.Condition;
Rcf_Name : constant String := "Rcf_Compiler";
Delay_Count : Natural := 0;
Rcf_Compiler_Failure : exception;
use Directory_Tools;
begin
Program.Create_Job
("""!Targets.Implementation.Rcf_User_Interface'Spec_View.Units"".Start_Rcf_Main",
Job, Condition,
Options => "output => !Machine.Error_Logs.Rcf_Compiler_Log");
if Program.Started_Successfully (Condition) then
while String_Utilities.Locate
(Rcf_Name, System_Utilities.Job_Name (Job)) = 0 loop
Delay_Count := Delay_Count + 1;
if Delay_Count > 60 then
raise Rcf_Compiler_Failure;
end if;
delay 2.0;
end loop;
Log.Put_Line ("Rcf Compiler Started", Profile.Positive_Msg);
else
raise Rcf_Compiler_Failure;
end if;
if Object.Is_Ok (The_Object => Naming.Resolution (Target_File_Name)) then
Io.Open (File => Target_File,
Mode => Io.In_File,
Name => Target_File_Name);
while not Io.End_Of_File (Target_File) loop
declare
Stripped_Target : constant String :=
String_Utilities.Strip (Io.Get_Line (Target_File));
begin
Program.Create_Job
(Program.Current
(Subsystem => Register_Context & "." & Stripped_Target,
Unit => Stripped_Target & ".Register",
Activity => "!Machine.Release.Current.Activity"),
Job, Condition,
Context => Register_Context);
if Program.Started_Successfully (Condition) then
Program.Wait_For (Job);
Log.Put_Line ("Registered Rcf target " & Stripped_Target);
else
Log.Put_Line ("Failed To Register", Profile.Error_Msg);
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize_Rcf",
Reason => Error_Reporting.Create_Condition_Name
("Unable to register rcf target " &
Stripped_Target, Error_Reporting.Warning),
Explanation => Simple_Status.Name (Condition));
end if;
end;
end loop;
Io.Close (Target_File);
else
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize_Rcf",
Reason => Error_Reporting.Create_Condition_Name
("No Rcf targets will be registered",
Error_Reporting.Warning),
Explanation => "Bad target file name: " & Target_File_Name);
end if;
exception
when Rcf_Compiler_Failure =>
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize_Rcf",
Reason => Error_Reporting.Create_Condition_Name
("Unable to start rcf", Error_Reporting.Problem),
Explanation => Simple_Status.Name (Condition));
when others =>
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize_Rcf",
Reason => Error_Reporting.Create_Condition_Name
("Unhandled_Exception", Error_Reporting.Problem),
Explanation => Debug_Tools.Get_Exception_Name (True, True));
end Initialize_Rcf;procedure Initialize_Teamwork_Interface;with Program;
with Debug_Tools;
with Simple_Status;
with Error_Reporting;
procedure Initialize_Teamwork_Interface is
package Dt renames Debug_Tools;
package Ss renames Simple_Status;
Activity : constant String := "!Machine.Release.Current.Activity";
Subsystem : constant String :=
"!Tools.Design.Rdf_Teamwork_Integration.Teamwork";
Initialization : constant String := "Initialize_Teamwork";
Caller : constant String := "!Machine.Initialize_Teamwork_Interface";
Job_Id : Program.Job_Id;
Status : Program.Condition;
function Initialization_Command return String is
begin
return Program.Current (Subsystem => Subsystem,
Unit => Initialization,
Activity => Activity);
end Initialization_Command;
begin
declare
Command : constant String := Initialization_Command;
begin
if Command'Length > 0 then
Program.Create_Job (Initialization_Command,
Job => Job_Id,
Status => Status);
end if;
end;
if not Program.Started_Successfully (Status) then
Error_Reporting.Report_Error
(Caller => Caller,
Reason => Error_Reporting.Create_Condition_Name
("Unable to initialize Teamwork_Interface ",
Error_Reporting.Problem),
Explanation => Ss.Display_Message (Status));
end if;
exception
when others =>
Error_Reporting.Report_Error
(Caller => Caller,
Reason => Error_Reporting.Create_Condition_Name
("UNHANDLED EXCEPTION", Error_Reporting.Problem),
Explanation => Dt.Get_Exception_Name (True, True));
end Initialize_Teamwork_Interface