|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 11942 (0x2ea6)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─ ⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦24d1ddd49⟧
└─⟦this⟧
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1988 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054-3197
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1988. ALL RIGHTS RESERVED.
--
--
separate (Task_Management)
package body Checking is
pragma Suppress_All;
-- function Operation (Error : Runtime_Error.Fatal_Error) return String is
-- pragma Routine_Number (Runtime_Ids.Internal);
-- begin
-- case Error is
-- when Err.Bad_Status_From_Wait_Nonblocking =>
-- return "Wait_Nonblocking";
-- when Err.Bad_Status_From_Wait =>
-- return "Wait";
-- when Err.Bad_Status_From_Length =>
-- return "Length";
-- when Err.Bad_Status_From_Remove_Message =>
-- return "Remove_Message";
-- when Err.Bad_Status_From_Send =>
-- return "Send";
-- when Err.Bad_Status_From_Send_Without_Priority =>
-- return "Send_Without_Priority";
-- when Err.Bad_Status_From_Retrieve_Message =>
-- return "Retrieve_Message";
-- when Err.Bad_Status_From_Create =>
-- return "Create";
-- when Err.Bad_Status_From_Delete =>
-- return "Delete";
-- when Err.Bad_Status_From_Delete_If_Empty =>
-- return "Delete_If_Empty";
--
-- when Err.Bad_Status_From_Start_Timer =>
-- return "Start";
-- when Err.Bad_Status_From_Stop_Timer =>
-- return "Stop";
--
-- when Err.Bad_Status_From_Set_Priority =>
-- return "Set_Priority";
-- when Err.Bad_Status_From_Fork =>
-- return "Fork";
--
-- when others =>
-- return "<unknown operation>";
-- end case;
-- end Operation;
procedure Check_Message_Queue_Status (Status : Mq.Stratus;
Error : Runtime_Error.Fatal_Error;
Current_Task : Task_Id) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
if Status /= Mq.Q_Success then
Runtime_Exceptions.Raise_Runtime_Error
("Check_Message_Queue_Status", Mq.Stratus'Image (Status), Error,
Current_Task => Current_Task);
end if;
end Check_Message_Queue_Status;
procedure Check_Timer_Status (Status : Timer.Stratus;
Error : Runtime_Error.Fatal_Error;
Current_Task : Task_Id) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
if Status /= Timer.Ti_Success then
Runtime_Exceptions.Raise_Runtime_Error
("Check_Timer_Status", Timer.Stratus'Image (Status), Error,
Current_Task => Current_Task);
end if;
end Check_Timer_Status;
-- procedure Check_Process_Ops_Status (Status : Process_Ops.Status;
-- Error : Runtime_Error.Fatal_Error;
-- Current_Task : Task_Id) is
-- pragma Routine_Number (Runtime_Ids.Internal);
-- begin
-- if Status /= Process_Ops.Success then
-- Runtime_Exceptions.Raise_Runtime_Error
-- ("Check_Process_Ops_Status",
-- Process_Ops.Status'Image (Status), Error,
-- Current_Task => Current_Task);
-- end if;
-- end Check_Process_Ops_Status;
procedure Check_Reply (Received : Reply_Kind;
Expected : Reply_Kind;
Current_Task : Task_Id) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
if Received /= Expected then
Runtime_Exceptions.Raise_Runtime_Error
("Check_Reply", Reply_Kind'Image (Received) & " /=" &
Reply_Kind'Image (Expected),
Err.Unexpected_Reply,
Current_Task => Current_Task);
end if;
end Check_Reply;
procedure Check_Task (The_Task : Task_Id;
Caller : String;
Current_Task : Task_Id) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
if The_Task = null then
Runtime_Exceptions.Raise_Runtime_Error
("Check_Task", "null task id", Err.Unexpected_Null_Task_Id,
Current_Task => Current_Task);
elsif The_Task.Checksum /= Checksum (The_Task) then
Runtime_Exceptions.Raise_Runtime_Error
("Check_Task", "bad checksum", Err.Bad_Tcb_Checksum,
Current_Task => Current_Task);
elsif Current_Task.Process_Id /= Process_Ops.Current_Process_Id then
--declare
-- Temp : Integer := Process_Ops.Current_Process_Id;
--begin
-- if Current_Task.Process_Id /= Temp then
-- Debugging.Put_Message
-- ("PID from Tcb is " &
-- Integer'Image (Current_Task.Process_Id));
-- Debugging.Put_Message ("PID from OS is " &
-- Integer'Image (Temp));
-- Debugging.Put_Tcb (Current_Task);
-- --***
-- end if;
Runtime_Exceptions.Raise_Runtime_Error
("Check_Task", "tcb/pid mismatch", Err.Tcb_Map_Error,
Current_Task => Current_Task);
end if;
end Check_Task;
--
-- procedure Check_Layer
-- (Layer : Layer_Id; Caller : String; Current_Task : Task_Id) is
-- pragma Routine_Number (Runtime_Ids.Internal);
-- Layer_Temp : Layer_Id;
-- Dependent : Task_Id;
-- Coldness, Prev_Coldness : Coldness_Value;
-- Found : Boolean := False;
-- Prev_Coldness_Valid : Boolean := False;
--
-- Caller_Name : constant String :=
-- "Check_Layer (called by " & Caller & ")";
-- begin
-- if Layer = null then
-- Runtime_Exceptions.Raise_Runtime_Error
-- (Caller_Name, "null layer_id", Err.Unexpected_Null_Layer,
-- Current_Task => Current_Task);
-- end if;
--
-- if Layer.Coldness = Root then
-- return;
-- end if;
--
-- Check_Task (Layer.Master_Task, Caller_Name,
-- Current_Task => Current_Task);
--
-- if Layer.Non_Terminated < Layer.Non_Terminable then
-- Runtime_Exceptions.Raise_Runtime_Error
-- (Caller_Name,
-- "non_terminable count exceeds non_terminated count",
-- Err.Layer_State_Inconsistency,
-- Current_Task => Current_Task);
-- end if;
--
-- Layer_Temp := Layer.Master_Task.Current_Layer;
--
-- while Layer_Temp /= null loop
-- if Debug_Mode then
-- Debugging.Put_Layer (Layer_Temp);
-- end if;
--
-- if Layer_Temp = Layer then
-- Found := True;
-- end if;
--
-- if Prev_Coldness_Valid then
-- Prev_Coldness := Coldness;
-- end if;
-- Coldness := Layer_Temp.Coldness;
--
-- case Coldness is
-- when Cold | Cool =>
-- if not Layer_Temp.Master_Task.Action_State
-- (Terminate_Open) then
-- Runtime_Exceptions.Raise_Runtime_Error
-- (Caller_Name,
-- "cold or cool layer's master_task does not have open terminate alternative",
-- Err.Layer_State_Inconsistency,
-- Current_Task => Current_Task);
-- end if;
-- if Prev_Coldness_Valid and then (Prev_Coldness /= Cold) then
-- Runtime_Exceptions.Raise_Runtime_Error
-- (Caller_Name,
-- "cold or cool layer found beneath non-cold layer",
-- Err.Layer_State_Inconsistency,
-- Current_Task => Current_Task);
-- end if;
-- if Layer_Temp.Non_Terminable > 0 and then
-- Coldness = Cold then
-- Runtime_Exceptions.Raise_Runtime_Error
-- (Caller_Name,
-- "cold layer found with positive nonterminable count",
-- Err.Layer_State_Inconsistency,
-- Current_Task => Current_Task);
-- end if;
--
-- when Warm =>
-- if Prev_Coldness_Valid then
-- case Prev_Coldness is
-- when Cold =>
-- Runtime_Exceptions.Raise_Runtime_Error
-- (Caller_Name,
-- "warm layer found beneath cold layer",
-- Err.Layer_State_Inconsistency,
-- Current_Task => Current_Task);
--
-- when Cool =>
-- if Layer_Temp.Non_Terminable = 0 then
-- Runtime_Exceptions.Raise_Runtime_Error
-- (Caller_Name,
-- "warm layer with zero non_terminable count found beneath cool layer",
-- Err.Layer_State_Inconsistency,
-- Current_Task => Current_Task);
-- end if;
--
-- when others =>
-- null;
-- end case;
-- end if;
--
-- when Root =>
-- Runtime_Exceptions.Raise_Runtime_Error
-- (Caller_Name, "root layer found on layer list",
-- Err.Layer_State_Inconsistency,
-- Current_Task => Current_Task);
-- end case;
--
-- Prev_Coldness_Valid := True;
-- Layer_Temp := Layer_Temp.Layer_Link;
-- end loop;
--
-- if not Found then
-- Runtime_Exceptions.Raise_Runtime_Error
-- (Caller_Name, "layer not found on its master_task's layer list",
-- Err.Layer_State_Inconsistency,
-- Current_Task => Current_Task);
-- end if;
--
-- Dependent := Layer.Dependent_Task_List.Next;
--
-- while Dependent /= null loop
-- Check_Task (Dependent, Caller_Name, Current_Task => Current_Task);
-- if Dependent.Master_Block /= Layer then
-- Runtime_Exceptions.Raise_Runtime_Error
-- (Caller_Name,
-- "dependent_task_list/master_block inconsistency found",
-- Err.Layer_State_Inconsistency,
-- Current_Task => Current_Task);
-- end if;
--
-- Dependent := Dependent.Layer_Link.Next;
-- end loop;
-- end Check_Layer;
end Checking;
pragma Runtime_Unit (Unit_Number => Runtime_Ids.Runtime_Compunit,
Elab_Routine_Number => Runtime_Ids.Internal);