home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 5
/
ctrom5b.zip
/
ctrom5b
/
PROGRAM
/
ADA
/
GNAT200
/
ADAINC
/
S-TASABO.ADB
< prev
next >
Wrap
Text File
|
1994-11-30
|
6KB
|
169 lines
------------------------------------------------------------------------------
-- --
-- GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K I N G . A B O R T I O N --
-- --
-- B o d y --
-- --
-- $Revision: 1.12 $ --
-- --
-- Copyright (c) 1991,1992,1993,1994, FSU, All Rights Reserved --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU Library General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. GNARL is distributed in the hope that it will be use- --
-- ful, but but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Gen- --
-- eral Library Public License for more details. You should have received --
-- a copy of the GNU Library General Public License along with GNARL; see --
-- file COPYING.LIB. If not, write to the Free Software Foundation, 675 --
-- Mass Ave, Cambridge, MA 02139, USA. --
-- --
------------------------------------------------------------------------------
with System.Tasking.Utilities;
-- Used for, Utilities.ID_To_ATCB,
-- Utilities.ATCB_To_ID,
-- Utilities.ATCB_Ptr,
-- Utilities.Terminated,
-- Utilities.Not_Accepting,
-- Utilities.All_Tasks_L,
-- Utilities.All_Tasks_List
-- Utilities.Abort_To_Level,
-- Utilities.Abort_Dependents
with System.Task_Primitives; use System.Task_Primitives;
package body System.Tasking.Abortion is
function ID_To_ATCB (ID : Task_ID) return Utilities.ATCB_Ptr
renames Utilities.ID_To_ATCB;
function ATCB_To_ID (Ptr : Utilities.ATCB_Ptr) return Task_ID
renames Utilities.ATCB_To_ID;
function "=" (L, R : Utilities.Task_Stage) return Boolean
renames Utilities."=";
function "=" (L, R : Utilities.ATCB_Ptr) return Boolean
renames Utilities."=";
function "=" (L, R : Utilities.Accepting_State) return Boolean
renames Utilities."=";
--------------------------
-- Change_Base_Priority --
--------------------------
procedure Change_Base_Priority (T : Utilities.ATCB_Ptr) is
begin
-- check for ceiling violations ???
T.Pending_Priority_Change := False;
T.Base_Priority := T.New_Base_Priority;
T.Current_Priority := T.Base_Priority;
Set_Priority (T.LL_TCB'Access, T. Current_Priority);
end Change_Base_Priority;
--------------------
-- Defer_Abortion --
--------------------
procedure Defer_Abortion is
T : Utilities.ATCB_Ptr := ID_To_ATCB (Self);
begin
T.Deferral_Level := T.Deferral_Level + 1;
end Defer_Abortion;
----------------------
-- Undefer_Abortion --
----------------------
-- Precondition : Self does not hold any locks!
-- Undefer_Abortion is called on any abortion completion point (aka.
-- synchonization point). It performs the following actions if they
-- are pending: (1) change the base priority, (2) abort the task.
-- The priority change has to occur before abortion. Otherwise, it would
-- take effect no earlier than the next abortion completion point.
-- This version of Undefer_Abortion redefers abortion if abortion is
-- in progress. There has been some discussion of having
-- the raise statement defer abortion to prevent abortion of
-- handlers performing required completion. This would make
-- the explicit deferral unnecessary. ???
procedure Undefer_Abortion is
T : Utilities.ATCB_Ptr := ID_To_ATCB (Self);
Error : Boolean;
begin
T.Deferral_Level := T.Deferral_Level - 1;
if T.Deferral_Level = ATC_Level'First and then T.Pending_Action then
Write_Lock (T.L, Error);
T.Pending_Action := False;
if T.Pending_Priority_Change then
Change_Base_Priority (T);
end if;
Unlock (T.L);
if T.Pending_ATC_Level < T.ATC_Nesting_Level then
T.Deferral_Level := T.Deferral_Level + 1;
raise Standard'Abort_Signal;
end if;
end if;
end Undefer_Abortion;
-----------------
-- Abort_Tasks --
-----------------
-- Called to initiate abortion, however, the actual abortion
-- is done by abortee by means of Abort_Handler
procedure Abort_Tasks (Tasks : Task_List) is
Abortee : Utilities.ATCB_Ptr;
Aborter : Utilities.ATCB_Ptr;
Activator : Utilities.ATCB_Ptr;
TAS_Result : Boolean;
Old_Pending_ATC_Level : ATC_Level_Base;
begin
Defer_Abortion;
-- Begin non-abortable section
Aborter := ID_To_ATCB (Self);
for J in Tasks'Range loop
Abortee := ID_To_ATCB (Tasks (J));
if Abortee.Stage = Utilities.Created then
Utilities.Complete (ATCB_To_ID (Abortee));
Abortee.Stage := Utilities.Terminated;
-- Task aborted before activation is safe to complete
-- Mark This task to be terminated.
else
Abortee.Accepting := Utilities.Not_Accepting;
Utilities.Complete_on_Sync_Point (ATCB_To_ID (Abortee));
Utilities.Abort_To_Level (ATCB_To_ID (Abortee), 0);
-- Process abortion of child tasks
Utilities.Abort_Dependents (ATCB_To_ID (Abortee));
end if;
end loop;
-- End non-abortable section
Undefer_Abortion;
end Abort_Tasks;
end System.Tasking.Abortion;