|
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: 32284 (0x7e1c)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦7105a2fbb⟧
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦808a58df6⟧
└─⟦this⟧
procedure Initialize;with Activity;
with Debug_Tools;
with Error_Reporting;
with Io;
with Log;
with Profile;
with Library;
with Program;
with Operator;
with Link_Tools;
with Compilation;
procedure Initialize is
begin
Io.Set_Output ("!Machine.Error_Logs.Machine_Initialize");
Io.Set_Error (Io.Current_Output);
Activity.Set ("!Machine.Release.Current.Activity");
Operator.Enable_Privileges;
if not Operator.Privileged_Mode then
Log.Put_Line ("Could not enable privileges.",
Kind => Profile.Error_Msg);
end if;
Library.Context ("!Machine.Error_Logs");
Program.Run ("""!Machine"".Initialize_Housekeeping;");
Program.Run ("""!Machine"".Initialize_Daemons;");
Program.Run ("""!Machine"".Initialize_Network;");
if Link_Tools.Has ("Install_Subsystems", "?",
Link_Tools.External, "!Machine") then
begin
Program.Run
("""!Machine'L.Install_Subsystems$"".Install_Subsystems;");
exception
when others =>
null;
end;
end if;
Library.Context ("!Machine.Error_Logs");
Program.Run ("""!Commands"".Gateway_Class.Boot_Time_Initialization");
Program.Run ("""!Machine"".Initialize_Terminals;");
Program.Run ("""!Machine"".Initialize_Servers;");
Program.Run ("""!Machine"".Initialize_Print_Spooler;");
Program.Run ("""!Machine"".Initialize_Site;");
Program.Run ("""!Machine"".Initialize_Mail;");
Program.Run ("""!Machine"".Initialize_Cross_Compilers;");
Program.Run ("""!Machine"".Initialize_Design_Facilities;");
Io.Reset_Output;
exception
when others =>
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize",
Reason => Error_Reporting.Create_Condition_Name
("Unhandled_Exception", Error_Reporting.Fatal),
Explanation => Debug_Tools.Get_Exception_Name (True, True));
end Initialize;procedure Initialize_Cross_Compilers;with Debug_Tools;
with Error_Reporting;
with Io;
with Program;
with Simple_Status;
with String_Utilities;
with System_Utilities;
procedure Initialize_Cross_Compilers is
File_Name : constant String := "!Machine.Cross_Compilers";
File : Io.File_Type;
procedure Close is
begin
Io.Close (File);
exception
when others =>
null;
end Close;
function Get_First_Token (From : String) return String is
begin
for Index in From'Range loop
if From (Index) = ' ' then
return From (From'First .. Index - 1);
end if;
end loop;
return From;
end Get_First_Token;
function Get_Remainder (From : String) return String is
begin
for Index in From'Range loop
if From (Index) = ' ' then
return From (Index + 1 .. From'Last);
end if;
end loop;
return "";
end Get_Remainder;
procedure Start_Compiler (Target_Entry : String) is
Target_Name : constant String := Get_First_Token (Target_Entry);
Params : constant String := Get_Remainder (Target_Entry);
Caller : constant String :=
"!Machine.Initialize_Cross_Compilers." & Target_Name;
Context : constant String := "!Targets.Implementation.";
Routine : constant String := "Start_Compiler";
Activity : constant String := "!Machine.Release.Current.Activity";
Job_Id : Program.Job_Id;
Status : Program.Condition;
procedure Await_Elaboration is
begin
if not Program.Started_Successfully (Status) then
Error_Reporting.Report_Error
(Caller => Caller,
Reason => Error_Reporting.Create_Condition_Name
("Unable to start compiler",
Error_Reporting.Problem),
Explanation => Simple_Status.Display_Message (Status));
end if;
for I in 1 .. 100 loop
begin
declare
Name : constant String :=
System_Utilities.Job_Name (Job_Id);
begin
if Name'First =
String_Utilities.Locate (Fragment => Target_Name,
Within => Name,
Ignore_Case => True) then
return;
end if;
delay 5.0;
end;
exception
when others =>
Error_Reporting.Report_Error
(Caller => Caller,
Reason => Error_Reporting.Create_Condition_Name
("Cannot get compiler job name",
Error_Reporting.Problem),
Explanation =>
Debug_Tools.Get_Exception_Name (True, True));
return;
end;
end loop;
Error_Reporting.Report_Error
(Caller => Caller,
Reason => Error_Reporting.Create_Condition_Name
("Compiler has not changed its name",
Error_Reporting.Problem),
Explanation => "");
end Await_Elaboration;
begin
if String_Utilities.Locate ("Motorola_68k", Target_Name) /= 0 then
-- with Common, Control, Stream, the Start_Compiler procedure
-- does not return until all components are started.
Program.Run (Program.Current (Subsystem => Context & Target_Name,
Unit => Routine,
Parameters => Params,
Activity => Activity));
else
Program.Create_Job
(Program.Current (Subsystem => Context & Target_Name,
Unit => Routine,
Activity => Activity),
Job_Id,
Status);
Await_Elaboration;
end if;
exception
when others =>
Error_Reporting.Report_Error
(Caller => Caller,
Reason => Error_Reporting.Create_Condition_Name
("Unhandled_Exception", Error_Reporting.Problem),
Explanation => Debug_Tools.Get_Exception_Name (True, True));
end Start_Compiler;
begin
begin
Io.Open (File => File, Mode => Io.In_File, Name => File_Name);
exception
when Io.Name_Error =>
-- file does not exist
return;
end;
begin
loop
Start_Compiler (String_Utilities.Strip_Leading
(Filler => ' ', From => Io.Get_Line (File)));
end loop;
exception
when Io.End_Error =>
Close;
end;
exception
when others =>
Close;
raise;
end Initialize_Cross_Compilers;procedure Initialize_Daemons;with Io;
with Daemon;
with Program;
with Error_Reporting;
with Debug_Tools;
with Disk_Daemon;
with Time_Utilities;
use Time_Utilities;
procedure Initialize_Daemons is
function "=" (L, R : Disk_Daemon.Threshold_Kinds) return Boolean
renames Disk_Daemon."=";
subtype Volume_Number is Disk_Daemon.Volume_Number;
subtype Bytes is Natural;
Kbyte : constant Bytes := 1024;
Mbyte : constant Bytes := 1024 * 1024;
subtype Threshold is Disk_Daemon.Percentage; -- eg, 10 means 10%
subtype Threshold_Kinds is Disk_Daemon.Threshold_Kinds;
type Threshold_Array is array (Threshold_Kinds) of Threshold;
function Min (Volume : Volume_Number) return Bytes is
begin
if Volume = 1 then
return (10 + 25) * Mbyte;
else
return 10 * Mbyte;
end if;
-- A Suspend threshold corresponding to 1 block is clearly worthless,
-- regardless of the size of the disk. Thus, you would expect there
-- to be some minimum absolute number of disk blocks to be included in
-- the suspend threshold. Assuming you recover from hitting the
-- suspend threshold by rebooting and elaborating just DDC, the
-- minimum needs to be higher than 10 Mbytes. You need to account for
-- swap space for the environment on volume 1.
end Min;
function New_Garbage (Consumed : Bytes) return Bytes is
begin
return (2 * Consumed) / 100; -- 2% of Consumed
-- GC has some tables whose size is a linear function of capacity. GC
-- produces new garbage while it is collecting the old garbage. The
-- amount of the new garbage is a linear function of capacity. We
-- assume that GC will produce 2% new garbage for the garbage that it
-- reclaims.
end New_Garbage;
function Suspend (Volume : Volume_Number;
Capacity : Bytes) return Bytes is
Fixed : constant Bytes := Min (Volume);
Variable : constant Bytes := 2 * New_Garbage (Capacity);
begin
return Fixed + Variable;
-- Assuming all of Capacity is garbage is clearly pessimistic. We
-- leave twice as much space as should be required because (1) failure
-- to leave enough space results in a restore from backup, and (2) the
-- procedure for recovering from hitting Suspend is very unfriendly
-- causing people to end up trying it 2 or 3 times, each wasted
-- attempt producing more garbage.
end Suspend;
function Get_Threshold (Kind : Threshold_Kinds;
Volume : Volume_Number;
Capacity : Bytes) return Bytes is
begin
if Kind = Disk_Daemon.Suspend_System then
return Suspend (Volume, Capacity);
else
declare
Next_Kind : constant Threshold_Kinds :=
Threshold_Kinds'Succ (Kind);
Next_Amount : constant Bytes :=
Get_Threshold (Next_Kind, Volume, Capacity);
Headroom : constant Bytes := Capacity - Next_Amount;
begin
return Next_Amount + New_Garbage (Headroom);
-- We assume that the headroom is ALL garbage when GC starts,
-- which is clearly pessimistic. The formula leaves enough
-- space for a complete GC cycle started AFTER the threshold
-- is reached.
end;
end if;
end Get_Threshold;
function To_Percent (Value : Bytes;
Capacity : Bytes) return Threshold is
begin
return Threshold ((Value * 100) / Capacity);
end To_Percent;
procedure Set (Volume : Volume_Number;
Capacity : Bytes) is
Thresholds : Threshold_Array;
Next_Threshold : Threshold := 0;
begin
-- Compute theoretical Thresholds
for K in Thresholds'Range loop
Thresholds (K) :=
To_Percent (Get_Threshold (K, Volume, Capacity), Capacity);
end loop;
-- Adjust for at least a 1% difference between thresholds
for K in reverse Thresholds'Range loop
if Next_Threshold >= Thresholds (K) then
Thresholds (K) := Next_Threshold + 1;
end if;
Next_Threshold := Thresholds (K);
end loop;
-- Preset thresholds to known, legal values
for K in reverse Thresholds'Range loop
Disk_Daemon.Set_Threshold
(Volume, K, 1 + Threshold_Kinds'Pos (Threshold_Kinds'Last) -
Threshold_Kinds'Pos (K));
end loop;
for K in Thresholds'Range loop
Disk_Daemon.Set_Threshold (Volume, K, Thresholds (K));
end loop;
end Set;
begin
-- Set Disk Daemon thresholds based on disk capacities
for Vol in 1 .. 4 loop
if Disk_Daemon.Exists (Vol) then
Set (Vol, Disk_Daemon.Capacity (Vol) * Kbyte);
end if;
end loop;
-- Snapshot parameters
Daemon.Snapshot_Warning_Message (20.0);
Daemon.Snapshot_Start_Message (False);
Daemon.Schedule ("Snapshot", 30 * Minute, 15 * Minute);
-- note that daemons are scheduled by default
Daemon.Set_Access_List_Compaction;
begin
Program.Run_Job
(S => Program.Current
(Subsystem => "!Commands.System_Maintenance",
Unit => "Smooth_Snapshots",
Parameters => "",
Activity => "!Machine.Release.Current.Activity"),
Debug => False,
Context => "$",
After => 0.0,
Options => "Name => (Smooth Snapshots)",
Response => "<PROFILE>");
exception
when others =>
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize_Daemons.Smooth_Snapshots",
Reason => Error_Reporting.Create_Condition_Name
("Unhandled_Exception", Error_Reporting.Problem),
Explanation => Debug_Tools.Get_Exception_Name (True, True));
end;
end Initialize_Daemons;procedure Initialize_Design_Facilities;with Debug_Tools;
with Error_Reporting;
with Io;
with Program;
with Simple_Status;
with String_Utilities;
procedure Initialize_Design_Facilities is
package Dt renames Debug_Tools;
package Ss renames Simple_Status;
package Su renames String_Utilities;
Activity : constant String := "!Machine.Release.Current.Activity";
Caller : constant String := "!Machine.Initialize_Design_Facilities";
File_Of_Pdls : constant String := "!Machine.Design_Facilities";
Pdl_File : Io.File_Type;
procedure Close is
begin
Io.Close (Pdl_File);
exception
when others =>
null;
end Close;
procedure Start_Pdl (Pdl_Name : String) is
Uc_Pdl_Name : constant String :=
Su.Upper_Case (Su.Strip (Pdl_Name));
Command_Options : constant String :=
"Input | Output | Error => !MACHINE.DEVICES.NIL";
Registration_Procedure : constant String := "REGISTER_PDL";
Job_Id : Program.Job_Id;
Status : Program.Condition;
function Get_Context (From_Command : String) return String is
Begin_Quote : constant Natural := From_Command'First;
End_Quote : constant Natural :=
Su.Reverse_Locate ('"', From_Command);
begin
return From_Command (Natural'Succ (Begin_Quote)
.. Natural'Pred (End_Quote));
end Get_Context;
function Pdl_Subsystem return String is
begin
if Uc_Pdl_Name (Uc_Pdl_Name'First) = '!' then
return Uc_Pdl_Name & ".PDL_DEFINITION";
else
return "!TOOLS.DESIGN.RELEASE." &
Uc_Pdl_Name & ".PDL_DEFINITION";
end if;
end Pdl_Subsystem;
function Registration_Command return String is
begin
return Program.Current (Subsystem => Pdl_Subsystem,
Unit => Registration_Procedure,
Activity => Activity);
end Registration_Command;
function Pdl_Invocation return String is
begin
return Caller & " (" & Pdl_Subsystem & ')';
end Pdl_Invocation;
begin
if Uc_Pdl_Name'Length = 0 then
return;
end if;
Program.Create_Job (Registration_Command,
Context => Get_Context (Registration_Command),
Options => Command_Options,
Job => Job_Id,
Status => Status);
if not Program.Started_Successfully (Status) then
Error_Reporting.Report_Error
(Caller => Pdl_Invocation,
Reason => Error_Reporting.Create_Condition_Name
("Unable to Register " & Uc_Pdl_Name,
Error_Reporting.Problem),
Explanation => Ss.Display_Message (Status));
end if;
exception
when Io.Name_Error =>
Error_Reporting.Report_Error
(Caller => Caller & ".Start_Pdl",
Reason => Error_Reporting.Create_Condition_Name
("Invalid_Pdl_Name", Error_Reporting.Problem),
Explanation => Uc_Pdl_Name & " cannot be found.");
when others =>
Error_Reporting.Report_Error
(Caller => Pdl_Invocation,
Reason => Error_Reporting.Create_Condition_Name
("Unhandled_Exception", Error_Reporting.Problem),
Explanation => Dt.Get_Exception_Name (True, True));
end Start_Pdl;
begin
begin
Io.Open (File => Pdl_File, Mode => Io.In_File, Name => File_Of_Pdls);
exception
when Io.Name_Error =>
-- File does not exist
return;
end;
begin
loop
Start_Pdl (Io.Get_Line (Pdl_File));
end loop;
exception
when Io.End_Error =>
Close;
end;
exception
when others =>
Close;
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_Design_Facilities;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_Housekeeping;with Library;
with Scheduler;
with Access_List;
procedure Initialize_Housekeeping is
begin
Library.Destroy (Existing => "!Machine.Temporary??",
Threshold => Natural'Last,
Limit => "<All_Worlds>",
Response => "<Errors>");
Library.Create_World
("!Machine.Temporary", Model => "", Response => "<Errors>");
Library.Set_Retention_Count
("!Machine.Temporary", 0, Response => "<Errors>");
Access_List.Set ("Network_Public => Rwcd", "!Machine.Temporary",
Response => "<Errors>");
Access_List.Set_Default ("Network_Public => Rwcd", "!Machine.Temporary",
Response => "<Errors>");
Library.Compact_Library ("!Machine.Error_Logs");
Library.Compact_Library ("!Machine.Queues.??'C(World)");
Scheduler.Set ("Background_Streams", 3);
Scheduler.Set ("Stream_Time 1", 2);
Scheduler.Set ("Stream_Time 2", 58);
Scheduler.Set ("Stream_Jobs 1", 3);
Scheduler.Set ("Foreground_Time_Limit", 300);
Scheduler.Set ("Max_Detached_Wsl", 5000);
Scheduler.Set ("Max_Attached_Wsl", 4000);
Scheduler.Set ("Min_Ce_Wsl", 150);
Scheduler.Set ("Max_Ce_Wsl", 500);
Scheduler.Set ("Min_Oe_Wsl", 75);
Scheduler.Set ("Max_Oe_Wsl", 750);
Scheduler.Set ("Min_Server_Wsl", 75);
Scheduler.Set ("Disk_Scheduling", 0);
end Initialize_Housekeeping;procedure Initialize_Mail;with Program;
with Debug_Tools;
with Error_Reporting;
procedure Initialize_Mail is
begin
Program.Run ("""!Machine.Transfer"".Initialize");
Program.Run ("""!Machine.Transfer.Distribute"".Initialize");
exception
when others =>
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize_Mail",
Reason => Error_Reporting.Create_Condition_Name
("Unhandled_Exception", Error_Reporting.Problem),
Explanation => Debug_Tools.Get_Exception_Name (True, True));
end Initialize_Mail;procedure Initialize_Network;with Debug_Tools;
with Error_Reporting;
with Ftp_Server;
with Program;
with Tcp_Ip_Boot;
with Network_Product;
with Ftp_Product;
with Rpc_Product;
procedure Initialize_Network is
begin
if Network_Product.Is_Installed ("TCP/IP") then
begin
Tcp_Ip_Boot (Exos_Prefix => "!Tools.Networking.");
exception
when others =>
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize_Network.TCP_IP_Boot",
Reason => Error_Reporting.Create_Condition_Name
("Unhandled_Exception",
Error_Reporting.Problem),
Explanation => Debug_Tools.Get_Exception_Name (True, True));
end;
end if;
if Ftp_Product.Is_Installed then
begin
delay 15.0;
Ftp_Server.Start;
exception
when others =>
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize_Network.FTP",
Reason => Error_Reporting.Create_Condition_Name
("Unhandled_Exception",
Error_Reporting.Problem),
Explanation => Debug_Tools.Get_Exception_Name (True, True));
end;
end if;
if Rpc_Product.Is_Installed then
begin
delay 15.0;
Program.Run_Job
("""!Commands"".Archive.Server",
Context => "!Machine.Error_Logs",
Options => "Output => !Machine.Error_Logs.Archive_Server_Log," &
"Name => (Archive Server), " &
"User=NETWORK_PUBLIC, Password=()");
exception
when others =>
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize_Network.Archive",
Reason => Error_Reporting.Create_Condition_Name
("Unhandled_Exception",
Error_Reporting.Problem),
Explanation => Debug_Tools.Get_Exception_Name (True, True));
end;
end if;
end Initialize_Network;procedure Initialize_Print_Spooler;with Queue;
procedure Initialize_Print_Spooler is
begin
Queue.Restart_Print_Spooler;
end Initialize_Print_Spooler;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_Servers;with Debug_Tools;
with Error_Reporting;
with Program;
procedure Initialize_Servers is
begin
delay 15.0;
begin
Program.Run_Job (Program.Current
("!Tools.CI", "CI.Login",
Activity => "!Machine.Release.Current.Activity"),
Options => "Name => (Console Command Interpreter)",
Context => "!Machine.Error_Logs");
exception
when others =>
Error_Reporting.Report_Error
(Caller => "!Machine.Initialize_Servers.Ci",
Reason => Error_Reporting.Create_Condition_Name
("Unhandled_Exception", Error_Reporting.Problem),
Explanation => Debug_Tools.Get_Exception_Name (True, True));
end;
end Initialize_Servers;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;procedure Initialize_Terminals;with Operator;
with Telnet_Product;
with Terminal;
procedure Initialize_Terminals is
begin
Terminal.Set_Logoff_On_Disconnect (Line => 16, Enabled => False);
-- for I in 17 .. 20 loop
-- Operator.Enable_Terminal (I);
-- Terminal.Set_Disconnect_On_Logoff (Line => I, Enabled => false);
-- end loop;
if Telnet_Product.Is_Installed then
for I in 240 .. 244 loop
-- for I in 240 .. 240 loop
Terminal.Set_Disconnect_On_Logoff (Line => I, Enabled => True);
Terminal.Set_Logoff_On_Disconnect (Line => I, Enabled => False);
Operator.Enable_Terminal (I);
end loop;
end if;
end Initialize_Terminals