|
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: 17174 (0x4316)
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 Creation_And_Activation is
pragma Suppress_All;
procedure Initialize_Master (For_Layer : Layer_Id) is
pragma Routine_Number (Runtime_Ids.Initialize_Master);
Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock;
begin
-- if Debug_Mode then
-- Debugging.Put_Message ("Entered Initialize_Master");
-- end if;
-- For_Layer.all :=
-- Layer'(Dependent_Task_List => (Next => null),
For_Layer.Dependent_Task_List.Next := null;
-- Master_Task => Current_Task,
For_Layer.Master_Task := Current_Task;
-- Layer_Link => Current_Task.Current_Layer,
For_Layer.Layer_Link := Current_Task.Current_Layer;
-- Non_Terminated => 0,
For_Layer.Non_Terminated := 0;
-- Non_Terminable => 0,
For_Layer.Non_Terminable := 0;
-- Coldness => Warm);
For_Layer.Coldness := Warm;
Current_Task.Current_Layer := For_Layer;
-- if Safety_Check then
-- Checking.Check_Layer (For_Layer, "Initialize_Master",
-- Current_Task => Current_Task);
-- end if;
Release_Lock;
end Initialize_Master;
function Create_Task (Activation_Group : Group_Ref;
Master : Layer_Id;
Start_Addr_Ref : Address_Ref;
Entry_Count : Entry_Number;
Stack_Space : Integer;
At_Priority : Integer;
Closure : System_Address;
Instance_Variable : System_Address) return Task_Id is
pragma Routine_Number (Runtime_Ids.Create_Task);
-- ** allocate new Tcb before acquiring lock, since could raise
-- ** Storage_Error:
New_Task : Task_Id := Storage_Manager.New_Task_Control_Block;
Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock;
Default_Task_Priority : Priority renames Main_Priority;
begin
-- if Debug_Mode then
-- Debugging.Put_Message ("Entered Create_Task");
-- end if;
--
-- if Safety_Check then
-- if Master = null then
-- Debugging.Put_Message ("*** ERROR - No master set up for task");
-- end if;
--
-- if Activation_Group = null then
-- Debugging.Put_Message
-- ("*** ERROR - No activation group set up for task");
-- end if;
--
-- Checking.Check_Layer (Master, "Create_Task",
-- Current_Task => Current_Task);
-- end if;
--New_Task.all :=
-- Task_Control_Block'
-- (Checksum => Checksum (New_Task),
New_Task.Checksum := Checksum (New_Task);
-- Exception_Id => Exceptions.No_Error,
New_Task.Exception_Id := null; -- := Exceptions.No_Error;
-- Stack_Bounds => (Null_Address, max (Stack_Space, Default));
New_Task.Stack_Bounds.First := To_Address (0);
if Stack_Space = 0 then
New_Task.Stack_Bounds.Size := Default_Task_Stack_Size;
else
New_Task.Stack_Bounds.Size := Stack_Space;
end if;
-- Action_State => Empty_Actions,
New_Task.Action_State := (others => False);
-- Suspension_State => Not_Activated,
New_Task.Suspension_State := Not_Activated;
-- Current_Priority => Set_Priority,
if At_Priority in Priority then
New_Task.Current_Priority := At_Priority;
else
New_Task.Current_Priority := Default_Task_Priority;
end if;
-- Partner_Priority => Priority'First,
New_Task.Partner_Priority := Priority'First;
-- Code_Start_Ref => Start_Addr_Ref,
New_Task.Code_Start_Ref := Start_Addr_Ref;
-- Current_Layer => null,
New_Task.Current_Layer := null;
-- Queues => Storage_Manager.New_Queues
-- (Entry_Count, Current_Task => Current_Task),
--*** New_Task.Queues created below
-- Master_Block => Master,
New_Task.Master_Block := Master;
-- Layer_Link => List'(Next => Master.Dependent_Task_List.Next),
New_Task.Layer_Link.Next := Master.Dependent_Task_List.Next;
-- Callers_Head => Empty_List,
New_Task.Callers_Head.Next := null;
-- Callers_Link =>
-- List'(Next => Activation_Group.all), -- temporary use
New_Task.Callers_Link.Next := Activation_Group.all; -- temporary use
-- Activations_In_Progress => Convert (Closure), -- temporary use
New_Task.Activations_In_Progress := Convert (Closure); -- temporary use
-- Spare
New_Task.Spare_Word0 := 0;
-- Process_Id => 0,
New_Task.Process_Id := 0;
-- Ipc_Buffer_List => null);
New_Task.Ipc_Buffer_List := null;
New_Task.Parent_Tcb := Current_Task;
New_Task.Parent_Frame_Link := Process_Ops.Get_Fp;
New_Task.Instance_Variable := Instance_Variable;
Master.Non_Terminated := Master.Non_Terminated + 1;
Master.Non_Terminable := Master.Non_Terminable + 1;
Master.Dependent_Task_List.Next := New_Task;
Activation_Group.all := New_Task;
-- *** New_Task.Queues := ...
-- creating queues can raise Storage_Error, so cannot hold lock
Release_Lock;
New_Task.Queues := Storage_Manager.New_Queues
(Entry_Count, Current_Task => Current_Task);
-- if Debug_Mode then
-- Debugging.Put_Message ("");
-- Debugging.Put_Message ("Task_Management.Create_Task result = ");
-- Debugging.Put_Tcb (New_Task);
-- Debugging.Put_Message ("");
-- end if;
return New_Task;
end Create_Task;
procedure Activate_Offspring (Activation_Group : Group_Ref;
Perform_Elaboration_Check : Boolean) is
pragma Routine_Number (Runtime_Ids.Activate_Offspring);
Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock;
Next_Task : Task_Id := Activation_Group.all;
Next_Next_Task : Task_Id;
Params : Fork_Parameters;
Reply : Reply_Kind;
begin
-- if Debug_Mode then
-- Debugging.Put_Message ("Entered Activate_Offspring");
-- end if;
Runtime_Exceptions.Check_For_Abnormality (Current_Task => Current_Task);
if Perform_Elaboration_Check then
while Next_Task /= null loop
if Next_Task.Code_Start_Ref.all = To_Address (0) then
-- Terminate all unstarted tasks in the activation group
-- before raising Program_Error. C93007A tests this.
Next_Task := Activation_Group.all;
while Next_Task /= null loop
if Next_Task.Suspension_State = Not_Activated then
Termination_And_Abortion.Forced_Termination
(Next_Task,
Term_Via_Abort => False,
Current_Task => Current_Task);
end if;
Next_Task := Next_Task.Callers_Link.Next;
end loop;
Runtime_Exceptions.Raise_Program_Error;
end if;
-- Until a task is activated, the Callers_Link field is
-- used to store the link to the next member of the
-- activation group.
Next_Task := Next_Task.Callers_Link.Next;
end loop;
Next_Task := Activation_Group.all;
end if;
Current_Task.Activations_In_Progress := 0;
Params.Global_Base_Address := Process_Ops.Global_Base_Address;
Params.Code_Start := Task_Code_Start;
while Next_Task /= null loop
-- if Safety_Check then
-- if (Next_Task.Suspension_State /= Not_Activated) and then
-- ((Next_Task.Suspension_State /= Terminated) or else
-- (not Next_Task.Action_State (Abnormal))) then
-- --
-- -- A task that is aborted before it is activated has its
-- -- Suspension_State set to Terminated.
--
-- Runtime_Exceptions.Raise_Runtime_Error
-- ("Activate_Offspring",
-- "Activating an already-activated task",
-- Err.Task_Activated_Twice,
-- Current_Task => Current_Task);
-- end if;
-- end if;
-- Until a task is activated, the Callers_Link field is
-- used to store the link to the next member of the
-- activation group. The Callers_Head field is set here
-- to reference the activator.
Next_Next_Task := Next_Task.Callers_Link.Next;
if not Next_Task.Action_State (Abnormal) then
Next_Task.Suspension_State := Not_Suspended;
Next_Task.Callers_Head := List'(Next => Current_Task);
Params.New_Task_Id := Next_Task;
Params.Instance_Variable := Next_Task.Instance_Variable;
-- if Debug_Mode then
-- Debugging.Put_Message
-- ("In Activate_Offspring, about to call Os9_Ops.Fork");
-- end if;
declare
Next_Priority : Integer := Integer
(Next_Task.Current_Priority);
Stack_Size : Integer := Next_Task.Stack_Bounds.Size;
Status : Process_Ops.Status;
Minimum_Stack_Size : constant := 64;
begin
if Next_Priority < Minimum_Os_Priority then
Next_Priority := Minimum_Os_Priority;
end if;
if Stack_Size < Minimum_Stack_Size then
Stack_Size := Minimum_Stack_Size;
end if;
Process_Ops.Fork (Params'Address, Fork_Parameters_Size,
Next_Priority, Stack_Size, Status);
if Status = Process_Ops.E_Noram then
if Debug_Mode then
Debugging.Put_Message
("In Activate_Offspring, Os9_Ops.Fork failed due to insufficient available memory");
end if;
-- Update TCB and layer state since task not activated
Next_Task.Suspension_State := Not_Activated;
Termination_And_Abortion.Forced_Termination
(The_Task => Next_Task,
Term_Via_Abort => False,
Current_Task => Current_Task);
-- Simulate effect of raising storage_error (sic)
-- during child's activation.
--
Current_Task.Action_State (Exception_Pending) := True;
Current_Task.Exception_Id := Exceptions.Tasking_Error;
else
-- if Debug_Mode then
-- Debugging.Put_Message
-- ("In Activate_Offspring, after call to Os9_Ops.Fork");
-- end if;
--
-- if Safety_Check then
-- Checking.Check_Os9_Ops_Status
-- (Status, Err.Bad_Status_From_Fork,
-- Current_Task => Current_Task);
-- end if;
if Status /= Process_Ops.Success then
Debugging.Put_Message
("Got bad status from fork " &
Process_Ops.Status'Image (Status));
end if;
Current_Task.Activations_In_Progress :=
Current_Task.Activations_In_Progress + 1;
end if;
end;
end if;
Next_Task := Next_Next_Task;
end loop;
Activation_Group.all := null;
-- It is desirable that all elements of the activation group
-- be forked before any of them begin to execute user code.
-- Otherwise there may be problems with a low priority parent
-- forking a medium priority child before a high priority child;
-- it would be possible for the medium priority child to starve the
-- parent and thereby prevent its sibling from ever being forked.
-- This is currently not a problem, because a task registers itself
-- (which involves acquiring the task management serialization
-- lock) before it begins to execute user code.
if Current_Task.Activations_In_Progress > 0 then
Message_Queue_Utilities.Await_Reply
(Child_Activating, Reply, Current_Task => Current_Task);
-- if Safety_Check then
-- Checking.Check_Reply (Reply, Activation_Group_Activated,
-- Current_Task => Current_Task);
-- end if;
end if;
Runtime_Exceptions.Check_For_Pending_Exception
(Current_Task => Current_Task);
Release_Lock;
end Activate_Offspring;
procedure Notify_Parent_Internal
(Tasking_Error_Found : Boolean; Current_Task : Task_Id) is
pragma Routine_Number (Runtime_Ids.Internal);
-- While a task is activating, the Callers_Head field is
-- used to store the task_id of the parent (i.e. activator,
-- as opposed to master) task.
--
Parent : Task_Id renames Current_Task.Callers_Head.Next;
Parent_Tcb : Task_Control_Block renames Parent.all;
Parent_Offspring_Count : Integer
renames Parent_Tcb.Activations_In_Progress;
begin
-- if Debug_Mode then
-- Debugging.Put_Message ("Entered Notify_Parent");
-- end if;
if Tasking_Error_Found then
Parent_Tcb.Action_State (Exception_Pending) := True;
Parent_Tcb.Exception_Id := Exceptions.Tasking_Error;
end if;
Parent_Offspring_Count := Parent_Offspring_Count - 1;
if Parent_Offspring_Count = 0 then
Message_Queue_Utilities.Send_Reply
(Parent, Activation_Group_Activated,
Current_Task => Current_Task);
end if;
-- if Safety_Check and then
-- Current_Task.Action_State (Activation_Done) then
-- Runtime_Exceptions.Raise_Runtime_Error
-- ("Notify_Parent", "child has already notified parent",
-- Err.Parent_Notified_Twice,
-- Current_Task => Current_Task);
-- end if;
Current_Task.Action_State (Activation_Done) := True;
Runtime_Exceptions.Check_For_Abnormality (Current_Task => Current_Task);
end Notify_Parent_Internal;
procedure Notify_Parent (Tasking_Error_Found : Boolean) is
pragma Routine_Number (Runtime_Ids.Notify_Parent);
Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock;
begin
Notify_Parent_Internal (Tasking_Error_Found,
Current_Task => Current_Task);
Release_Lock;
end Notify_Parent;
end Creation_And_Activation;
pragma Runtime_Unit (Unit_Number => Runtime_Ids.Runtime_Compunit,
Elab_Routine_Number => Runtime_Ids.Internal);