mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-05 17:00:58 +08:00
s-taprob.adb (Unlock): Change the ceiling priority of the underlying lock, if needed.
2007-04-20 Jose Ruiz <ruiz@adacore.com> Arnaud Charlet <charlet@adacore.com> * s-taprob.adb (Unlock): Change the ceiling priority of the underlying lock, if needed. * s-taprop.ads (Set_Ceiling): Add this procedure to change the ceiling priority associated to a lock. * s-tpoben.adb ([Vulnerable_]Complete_Task, Lock_Entries): Relax assertion to take into account case of no abort restriction. (Initialize_Protection_Entries): Add initialization for the field New_Ceiling associated to the protected object. (Unlock_Entries): Change the ceiling priority of the underlying lock, if needed. * s-solita.adb (Get_Current_Excep): Moved back to s-tasini/s-tarest, since this function needs to be set consistently with Update_Exception. * s-tarest.adb (Get_Current_Excep): Moved back to s-tasini/s-tarest, since this function needs to be set consistently with Update_Exception. * s-taskin.ads: Update comments on Interrupt_Server_Blocked_On_Event_Flag. (Unbind_Handler): Fix handling of server_task wakeup (Server_Task): Set self's state so that Unbind_Handler can take appropriate actions. (Common_ATCB): Now use a constant from System.Parameters to determine the max size of the Task_Image field. * s-tassta.adb (Task_Wrapper): Now pass the overflow guard to the Initialize_Analyzer function. ([Vulnerable_]Complete_Task, Lock_Entries): Relax assertion to take into account case of no abort restriction. ([Vulnerable_]Complete_Master): Modify assertion. * s-tataat.adb (Finalize): Use the nestable versions of Defer/Undefer_Abort. * s-tpobop.adb (Protected_Entry_Call): Relax assertion. * s-tpobop.ads: Update comments. * s-tposen.adb (Protected_Single_Entry_Call): Call Lock_Entry instead of locking the object manually, to avoid inconsistencies between Lock/Unlock_Entry assertions. * s-interr.ads, s-interr.adb (Server_Task): Fix race condition when terminating application and System.Parameters.No_Abort is True. Update comments on Interrupt_Server_Blocked_On_Event_Flag. (Unbind_Handler): Fix handling of server_task wakeup (Server_Task): Set self's state so that Unbind_Handler can take appropriate actions. From-SVN: r125458
This commit is contained in:
Jose Ruiz
Arnaud Charlet
parent
b9f3a4b07d
commit
72fb810db9
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -120,7 +120,7 @@ with System.Tasking.Initialization;
|
||||
with System.Parameters;
|
||||
-- used for Single_Lock
|
||||
|
||||
with Unchecked_Conversion;
|
||||
with Ada.Unchecked_Conversion;
|
||||
|
||||
package body System.Interrupts is
|
||||
|
||||
@ -133,7 +133,7 @@ package body System.Interrupts is
|
||||
package IMNG renames System.Interrupt_Management;
|
||||
package IMOP renames System.Interrupt_Management.Operations;
|
||||
|
||||
function To_System is new Unchecked_Conversion
|
||||
function To_System is new Ada.Unchecked_Conversion
|
||||
(Ada.Task_Identification.Task_Id, Task_Id);
|
||||
|
||||
-----------------
|
||||
@ -220,16 +220,16 @@ package body System.Interrupts is
|
||||
-- Holds the task and entry index (if any) for each interrupt
|
||||
|
||||
Blocked : array (Interrupt_ID'Range) of Boolean := (others => False);
|
||||
pragma Volatile_Components (Blocked);
|
||||
pragma Atomic_Components (Blocked);
|
||||
-- True iff the corresponding interrupt is blocked in the process level
|
||||
|
||||
Ignored : array (Interrupt_ID'Range) of Boolean := (others => False);
|
||||
pragma Volatile_Components (Ignored);
|
||||
pragma Atomic_Components (Ignored);
|
||||
-- True iff the corresponding interrupt is blocked in the process level
|
||||
|
||||
Last_Unblocker :
|
||||
array (Interrupt_ID'Range) of Task_Id := (others => Null_Task);
|
||||
pragma Volatile_Components (Last_Unblocker);
|
||||
pragma Atomic_Components (Last_Unblocker);
|
||||
-- Holds the ID of the last Task which Unblocked this Interrupt.
|
||||
-- It contains Null_Task if no tasks have ever requested the
|
||||
-- Unblocking operation or the Interrupt is currently Blocked.
|
||||
@ -567,7 +567,7 @@ package body System.Interrupts is
|
||||
Handler_Addr : System.Address;
|
||||
end record;
|
||||
|
||||
function To_Fat_Ptr is new Unchecked_Conversion
|
||||
function To_Fat_Ptr is new Ada.Unchecked_Conversion
|
||||
(Parameterless_Handler, Fat_Ptr);
|
||||
|
||||
Ptr : R_Link;
|
||||
@ -762,25 +762,41 @@ package body System.Interrupts is
|
||||
--------------------
|
||||
|
||||
procedure Unbind_Handler (Interrupt : Interrupt_ID) is
|
||||
Server : System.Tasking.Task_Id;
|
||||
begin
|
||||
if not Blocked (Interrupt) then
|
||||
|
||||
-- Currently, there is a Handler or an Entry attached and
|
||||
-- corresponding Server_Task is waiting on "sigwait."
|
||||
-- We have to wake up the Server_Task and make it
|
||||
-- wait on condition variable by sending an
|
||||
-- Abort_Task_Interrupt
|
||||
|
||||
POP.Abort_Task (Server_ID (Interrupt));
|
||||
Server := Server_ID (Interrupt);
|
||||
|
||||
-- Make sure corresponding Server_Task is out of its own
|
||||
-- sigwait state.
|
||||
case Server.Common.State is
|
||||
when Interrupt_Server_Idle_Sleep |
|
||||
Interrupt_Server_Blocked_Interrupt_Sleep
|
||||
=>
|
||||
POP.Wakeup (Server, Server.Common.State);
|
||||
|
||||
Ret_Interrupt :=
|
||||
Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
|
||||
when Interrupt_Server_Blocked_On_Event_Flag =>
|
||||
POP.Abort_Task (Server);
|
||||
|
||||
pragma Assert
|
||||
(Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt));
|
||||
-- Make sure corresponding Server_Task is out of its
|
||||
-- own sigwait state.
|
||||
|
||||
Ret_Interrupt :=
|
||||
Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
|
||||
pragma Assert
|
||||
(Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt));
|
||||
|
||||
when Runnable =>
|
||||
null;
|
||||
|
||||
when others =>
|
||||
pragma Assert (False);
|
||||
null;
|
||||
end case;
|
||||
|
||||
IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
||||
|
||||
@ -1120,7 +1136,7 @@ package body System.Interrupts is
|
||||
IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
|
||||
|
||||
if User_Handler (Interrupt).H /= null
|
||||
or else User_Entry (Interrupt).T /= Null_Task
|
||||
or else User_Entry (Interrupt).T /= Null_Task
|
||||
then
|
||||
-- This is the case where the Server_Task is waiting
|
||||
-- on "sigwait." Wake it up by sending an
|
||||
@ -1325,14 +1341,23 @@ package body System.Interrupts is
|
||||
-- from status change (Unblocked -> Blocked). If that is not
|
||||
-- the case, we should exceute the attached Procedure or Entry.
|
||||
|
||||
Self_ID.Common.State := Interrupt_Server_Blocked_On_Event_Flag;
|
||||
POP.Unlock (Self_ID);
|
||||
|
||||
if Single_Lock then
|
||||
POP.Unlock_RTS;
|
||||
end if;
|
||||
|
||||
-- Avoid race condition when terminating application and
|
||||
-- System.Parameters.No_Abort is True.
|
||||
|
||||
if Parameters.No_Abort and then Self_ID.Pending_Action then
|
||||
Initialization.Do_Pending_Action (Self_ID);
|
||||
end if;
|
||||
|
||||
Ret_Interrupt :=
|
||||
Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
|
||||
Self_ID.Common.State := Runnable;
|
||||
|
||||
if Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt) then
|
||||
|
||||
@ -1458,7 +1483,7 @@ begin
|
||||
-- process during the RTS start up. (See processing in s-inmaop.adb). Pass
|
||||
-- the Interrupt_Mask of the environment task to the Interrupt_Manager.
|
||||
|
||||
-- Note : At this point we know that all tasks are masked for non-reserved
|
||||
-- Note: At this point we know that all tasks are masked for non-reserved
|
||||
-- signals. Only the Interrupt_Manager will have masks set up differently
|
||||
-- inheriting the original environment task's mask.
|
||||
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -209,7 +209,7 @@ package System.Interrupts is
|
||||
(Handler_Addr : System.Address);
|
||||
-- This routine should be called by the compiler to allow the handler be
|
||||
-- used as an Interrupt Handler. That means call this procedure for each
|
||||
-- pragma Interrup_Handler providing the address of the handler (not
|
||||
-- pragma Interrupt_Handler providing the address of the handler (not
|
||||
-- including the pointer to the actual PO, this way this routine is called
|
||||
-- only once for each type definition of PO).
|
||||
|
||||
|
||||
@ -85,9 +85,6 @@ package body System.Soft_Links.Tasking is
|
||||
procedure Set_Sec_Stack_Addr (Addr : Address);
|
||||
-- Get/Set location of current task's secondary stack
|
||||
|
||||
function Get_Current_Excep return SSL.EOA;
|
||||
-- Task-safe version of SSL.Get_Current_Excep
|
||||
|
||||
procedure Timed_Delay_T (Time : Duration; Mode : Integer);
|
||||
-- Task-safe version of SSL.Timed_Delay
|
||||
|
||||
@ -98,11 +95,6 @@ package body System.Soft_Links.Tasking is
|
||||
-- Soft-Link Get Bodies --
|
||||
--------------------------
|
||||
|
||||
function Get_Current_Excep return SSL.EOA is
|
||||
begin
|
||||
return STPO.Self.Common.Compiler_Data.Current_Excep'Access;
|
||||
end Get_Current_Excep;
|
||||
|
||||
function Get_Jmpbuf_Address return Address is
|
||||
begin
|
||||
return STPO.Self.Common.Compiler_Data.Jmpbuf_Address;
|
||||
@ -217,7 +209,6 @@ package body System.Soft_Links.Tasking is
|
||||
SSL.Set_Jmpbuf_Address := Set_Jmpbuf_Address'Access;
|
||||
SSL.Get_Sec_Stack_Addr := Get_Sec_Stack_Addr'Access;
|
||||
SSL.Set_Sec_Stack_Addr := Set_Sec_Stack_Addr'Access;
|
||||
SSL.Get_Current_Excep := Get_Current_Excep'Access;
|
||||
SSL.Timed_Delay := Timed_Delay_T'Access;
|
||||
SSL.Task_Termination_Handler := Task_Termination_Handler_T'Access;
|
||||
|
||||
|
||||
@ -40,6 +40,7 @@ with System.Task_Primitives.Operations;
|
||||
-- used for Write_Lock
|
||||
-- Unlock
|
||||
-- Self
|
||||
-- Set_Ceiling
|
||||
|
||||
with System.Parameters;
|
||||
-- used for Runtime_Traces
|
||||
@ -55,6 +56,13 @@ package body System.Tasking.Protected_Objects is
|
||||
use System.Task_Primitives.Operations;
|
||||
use System.Traces;
|
||||
|
||||
----------------
|
||||
-- Local Data --
|
||||
----------------
|
||||
|
||||
Locking_Policy : Character;
|
||||
pragma Import (C, Locking_Policy, "__gl_locking_policy");
|
||||
|
||||
-------------------------
|
||||
-- Finalize_Protection --
|
||||
-------------------------
|
||||
@ -255,6 +263,18 @@ package body System.Tasking.Protected_Objects is
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Before releasing the mutex we must actually update its ceiling
|
||||
-- priority if it has been changed.
|
||||
|
||||
if Object.New_Ceiling /= Object.Ceiling then
|
||||
if Locking_Policy = 'C' then
|
||||
System.Task_Primitives.Operations.Set_Ceiling
|
||||
(Object.L'Access, Object.New_Ceiling);
|
||||
end if;
|
||||
|
||||
Object.Ceiling := Object.New_Ceiling;
|
||||
end if;
|
||||
|
||||
Unlock (Object.L'Access);
|
||||
|
||||
if Parameters.Runtime_Traces then
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -138,11 +138,13 @@ package System.Task_Primitives.Operations is
|
||||
-- more details.
|
||||
|
||||
procedure Initialize_Lock
|
||||
(Prio : System.Any_Priority; L : not null access Lock);
|
||||
(Prio : System.Any_Priority;
|
||||
L : not null access Lock);
|
||||
procedure Initialize_Lock
|
||||
(L : not null access RTS_Lock; Level : Lock_Level);
|
||||
(L : not null access RTS_Lock;
|
||||
Level : Lock_Level);
|
||||
pragma Inline (Initialize_Lock);
|
||||
-- Initialize a lock object.
|
||||
-- Initialize a lock object
|
||||
--
|
||||
-- For Lock, Prio is the ceiling priority associated with the lock. For
|
||||
-- RTS_Lock, the ceiling is implicitly Priority'Last.
|
||||
@ -158,9 +160,9 @@ package System.Task_Primitives.Operations is
|
||||
-- unless the lock object has been initialized and has not since been
|
||||
-- finalized.
|
||||
--
|
||||
-- Initialization of the per-task lock is implicit in Create_Task.
|
||||
-- Initialization of the per-task lock is implicit in Create_Task
|
||||
--
|
||||
-- These operations raise Storage_Error if a lack of storage is detected.
|
||||
-- These operations raise Storage_Error if a lack of storage is detected
|
||||
|
||||
procedure Finalize_Lock (L : not null access Lock);
|
||||
procedure Finalize_Lock (L : not null access RTS_Lock);
|
||||
@ -169,9 +171,11 @@ package System.Task_Primitives.Operations is
|
||||
-- corresponding Initialize_Lock operation.
|
||||
|
||||
procedure Write_Lock
|
||||
(L : not null access Lock; Ceiling_Violation : out Boolean);
|
||||
(L : not null access Lock;
|
||||
Ceiling_Violation : out Boolean);
|
||||
procedure Write_Lock
|
||||
(L : not null access RTS_Lock; Global_Lock : Boolean := False);
|
||||
(L : not null access RTS_Lock;
|
||||
Global_Lock : Boolean := False);
|
||||
procedure Write_Lock
|
||||
(T : ST.Task_Id);
|
||||
pragma Inline (Write_Lock);
|
||||
@ -198,7 +202,8 @@ package System.Task_Primitives.Operations is
|
||||
-- per-task lock is implicit in Exit_Task.
|
||||
|
||||
procedure Read_Lock
|
||||
(L : not null access Lock; Ceiling_Violation : out Boolean);
|
||||
(L : not null access Lock;
|
||||
Ceiling_Violation : out Boolean);
|
||||
pragma Inline (Read_Lock);
|
||||
-- Lock a lock object for read access. After this operation returns,
|
||||
-- the calling task has non-exclusive read permission for the logical
|
||||
@ -223,11 +228,12 @@ package System.Task_Primitives.Operations is
|
||||
procedure Unlock
|
||||
(L : not null access Lock);
|
||||
procedure Unlock
|
||||
(L : not null access RTS_Lock; Global_Lock : Boolean := False);
|
||||
(L : not null access RTS_Lock;
|
||||
Global_Lock : Boolean := False);
|
||||
procedure Unlock
|
||||
(T : ST.Task_Id);
|
||||
pragma Inline (Unlock);
|
||||
-- Unlock a locked lock object.
|
||||
-- Unlock a locked lock object
|
||||
--
|
||||
-- The effect is undefined unless the calling task holds read or write
|
||||
-- permission for the lock L, and L is the lock object most recently
|
||||
@ -251,12 +257,11 @@ package System.Task_Primitives.Operations is
|
||||
-- done at interrupt priority. In general, it is not acceptable to give
|
||||
-- all RTS locks interrupt priority, since that whould give terrible
|
||||
-- performance on systems where this has the effect of masking hardware
|
||||
-- interrupts, though we could get away with allowing
|
||||
-- Interrupt_Priority'last where we are layered on an OS that does not
|
||||
-- allow us to mask interrupts. Ideally, we would like to raise
|
||||
-- Program_Error back at the original point of the RTS call, but this
|
||||
-- would require a lot of detailed analysis and recoding, with almost
|
||||
-- certain performance penalties.
|
||||
-- interrupts, though we could get away allowing Interrupt_Priority'last
|
||||
-- where we are layered on an OS that does not allow us to mask interrupts.
|
||||
-- Ideally, we would like to raise Program_Error back at the original point
|
||||
-- of the RTS call, but this would require a lot of detailed analysis and
|
||||
-- recoding, with almost certain performance penalties.
|
||||
|
||||
-- For POSIX systems, we considered just skipping setting priority ceiling
|
||||
-- on RTS locks. This would mean there is no ceiling violation, but we
|
||||
@ -286,6 +291,18 @@ package System.Task_Primitives.Operations is
|
||||
|
||||
-- For now, we will just shut down the system if there is ceiling violation
|
||||
|
||||
procedure Set_Ceiling
|
||||
(L : not null access Lock;
|
||||
Prio : System.Any_Priority);
|
||||
pragma Inline (Set_Ceiling);
|
||||
-- Change the ceiling priority associated to the lock
|
||||
--
|
||||
-- The effect is undefined unless the calling task holds read or write
|
||||
-- permission for the lock L, and L is the lock object most recently
|
||||
-- locked by the calling task for which the calling task still holds
|
||||
-- read or write permission. (That is, matching pairs of Lock and Unlock
|
||||
-- operations on each lock object must be properly nested.)
|
||||
|
||||
procedure Yield (Do_Yield : Boolean := True);
|
||||
pragma Inline (Yield);
|
||||
-- Yield the processor. Add the calling task to the tail of the ready
|
||||
@ -326,15 +343,15 @@ package System.Task_Primitives.Operations is
|
||||
-- Extensions --
|
||||
----------------
|
||||
|
||||
-- Whoever calls either of the Sleep routines is responsible
|
||||
-- for checking for pending aborts before the call.
|
||||
-- Pending priority changes are handled internally.
|
||||
-- Whoever calls either of the Sleep routines is responsible for checking
|
||||
-- for pending aborts before the call. Pending priority changes are handled
|
||||
-- internally.
|
||||
|
||||
procedure Sleep
|
||||
(Self_ID : ST.Task_Id;
|
||||
Reason : System.Tasking.Task_States);
|
||||
pragma Inline (Sleep);
|
||||
-- Wait until the current task, T, is signaled to wake up.
|
||||
-- Wait until the current task, T, is signaled to wake up
|
||||
--
|
||||
-- precondition:
|
||||
-- The calling task is holding its own ATCB lock
|
||||
@ -400,8 +417,8 @@ package System.Task_Primitives.Operations is
|
||||
-- setup/cleared upon entrance/exit of RTS while maintaining a single
|
||||
-- thread of control in the RTS. Since we intend these routines to be used
|
||||
-- for implementing the Single_Lock RTS, Lock_RTS should follow the first
|
||||
-- Defer_Abortion operation entering RTS. In the same fashion Unlock_RTS
|
||||
-- should preceed the last Undefer_Abortion exiting RTS.
|
||||
-- Defer_Abort operation entering RTS. In the same fashion Unlock_RTS
|
||||
-- should preceed the last Undefer_Abort exiting RTS.
|
||||
--
|
||||
-- These routines also replace the functions Lock/Unlock_All_Tasks_List
|
||||
|
||||
|
||||
@ -93,6 +93,9 @@ package body System.Tasking.Restricted.Stages is
|
||||
-- Tasking versions of services needed by non-tasking programs --
|
||||
-----------------------------------------------------------------
|
||||
|
||||
function Get_Current_Excep return SSL.EOA;
|
||||
-- Task-safe version of SSL.Get_Current_Excep
|
||||
|
||||
procedure Task_Lock;
|
||||
-- Locks out other tasks. Preceding a section of code by Task_Lock and
|
||||
-- following it by Task_Unlock creates a critical region. This is used
|
||||
@ -126,6 +129,15 @@ package body System.Tasking.Restricted.Stages is
|
||||
-- installing tasking versions of certain operations used by the compiler.
|
||||
-- Init_RTS is called during elaboration.
|
||||
|
||||
-----------------------
|
||||
-- Get_Current_Excep --
|
||||
-----------------------
|
||||
|
||||
function Get_Current_Excep return SSL.EOA is
|
||||
begin
|
||||
return STPO.Self.Common.Compiler_Data.Current_Excep'Access;
|
||||
end Get_Current_Excep;
|
||||
|
||||
---------------
|
||||
-- Task_Lock --
|
||||
---------------
|
||||
@ -616,9 +628,10 @@ package body System.Tasking.Restricted.Stages is
|
||||
-- Notify that the tasking run time has been elaborated so that
|
||||
-- the tasking version of the soft links can be used.
|
||||
|
||||
SSL.Lock_Task := Task_Lock'Access;
|
||||
SSL.Unlock_Task := Task_Unlock'Access;
|
||||
SSL.Adafinal := Finalize_Global_Tasks'Access;
|
||||
SSL.Lock_Task := Task_Lock'Access;
|
||||
SSL.Unlock_Task := Task_Unlock'Access;
|
||||
SSL.Adafinal := Finalize_Global_Tasks'Access;
|
||||
SSL.Get_Current_Excep := Get_Current_Excep'Access;
|
||||
|
||||
-- Initialize the tasking soft links (if not done yet) that are common
|
||||
-- to the full and the restricted run times.
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -55,7 +55,7 @@ with System.Task_Primitives;
|
||||
with System.Stack_Usage;
|
||||
-- used for Stack_Analyzer
|
||||
|
||||
with Unchecked_Conversion;
|
||||
with Ada.Unchecked_Conversion;
|
||||
|
||||
package System.Tasking is
|
||||
pragma Preelaborate;
|
||||
@ -128,8 +128,10 @@ package System.Tasking is
|
||||
-- This is the compiler interface version of this function. Do not call
|
||||
-- from the run-time system.
|
||||
|
||||
function To_Task_Id is new Unchecked_Conversion (System.Address, Task_Id);
|
||||
function To_Address is new Unchecked_Conversion (Task_Id, System.Address);
|
||||
function To_Task_Id is
|
||||
new Ada.Unchecked_Conversion (System.Address, Task_Id);
|
||||
function To_Address is
|
||||
new Ada.Unchecked_Conversion (Task_Id, System.Address);
|
||||
|
||||
-----------------------
|
||||
-- Enumeration types --
|
||||
@ -200,8 +202,8 @@ package System.Tasking is
|
||||
-- The task has been held by Asynchronous_Task_Control.Hold_Task
|
||||
|
||||
Interrupt_Server_Blocked_On_Event_Flag
|
||||
-- The task has been blocked on a system call waiting for the
|
||||
-- completion event.
|
||||
-- The task has been blocked on a system call waiting for a
|
||||
-- completion event/signal to occur.
|
||||
);
|
||||
|
||||
type Call_Modes is
|
||||
@ -473,7 +475,7 @@ package System.Tasking is
|
||||
-- are invoked from protected actions. pragma Atomic is used because it
|
||||
-- can be read/written from protected interrupt handlers.
|
||||
|
||||
Task_Image : String (1 .. 32);
|
||||
Task_Image : String (1 .. System.Parameters.Max_Task_Image_Length);
|
||||
-- Hold a string that provides a readable id for task,
|
||||
-- built from the variable of which it is a value or component.
|
||||
|
||||
@ -991,8 +993,8 @@ package System.Tasking is
|
||||
-- this value.
|
||||
|
||||
Deferral_Level : Natural := 1;
|
||||
-- This is the number of times that Defer_Abortion has been called by
|
||||
-- this task without a matching Undefer_Abortion call. Abortion is only
|
||||
-- This is the number of times that Defer_Abort has been called by
|
||||
-- this task without a matching Undefer_Abort call. Abortion is only
|
||||
-- allowed when this zero. It is initially 1, to protect the task at
|
||||
-- startup.
|
||||
|
||||
@ -1065,6 +1067,7 @@ package System.Tasking is
|
||||
-- documentation, mention T, and describe Success ???
|
||||
|
||||
private
|
||||
|
||||
Null_Task : constant Task_Id := null;
|
||||
|
||||
type Activation_Chain is limited record
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -66,7 +66,6 @@ with System.Tasking.Initialization;
|
||||
-- Used for Remove_From_All_Tasks_List
|
||||
-- Defer_Abort
|
||||
-- Undefer_Abort
|
||||
-- Initialization.Poll_Base_Priority_Change
|
||||
-- Finalize_Attributes_Link
|
||||
-- Initialize_Attributes_Link
|
||||
|
||||
@ -102,7 +101,7 @@ with System.Standard_Library;
|
||||
with System.Traces.Tasking;
|
||||
-- Used for Send_Trace_Info
|
||||
|
||||
with Unchecked_Deallocation;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
-- To recover from failure of ATCB initialization
|
||||
|
||||
with System.Stack_Usage;
|
||||
@ -129,7 +128,7 @@ package body System.Tasking.Stages is
|
||||
-----------------------
|
||||
|
||||
procedure Free is new
|
||||
Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
|
||||
Ada.Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
|
||||
|
||||
procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_Id);
|
||||
-- This procedure outputs the task specific message for exception
|
||||
@ -179,7 +178,7 @@ package body System.Tasking.Stages is
|
||||
-- For tasks created by an allocator that fails, due to an exception,
|
||||
-- it is called from Expunge_Unactivated_Tasks.
|
||||
--
|
||||
-- It is also called from Unchecked_Deallocation, for objects that
|
||||
-- It is also called from Ada.Unchecked_Deallocation, for objects that
|
||||
-- are or contain tasks.
|
||||
--
|
||||
-- Different code is used at master completion, in Terminate_Dependents,
|
||||
@ -387,7 +386,7 @@ package body System.Tasking.Stages is
|
||||
Write_Lock (Self_ID);
|
||||
Self_ID.Common.State := Activator_Sleep;
|
||||
|
||||
C := Chain_Access.T_ID;
|
||||
C := Chain_Access.T_ID;
|
||||
while C /= null loop
|
||||
Write_Lock (C);
|
||||
|
||||
@ -411,7 +410,6 @@ package body System.Tasking.Stages is
|
||||
-- unsafe to abort any of these tasks until the count goes to zero.
|
||||
|
||||
loop
|
||||
Initialization.Poll_Base_Priority_Change (Self_ID);
|
||||
exit when Self_ID.Common.Wait_Count = 0;
|
||||
Sleep (Self_ID, Activator_Sleep);
|
||||
end loop;
|
||||
@ -472,7 +470,9 @@ package body System.Tasking.Stages is
|
||||
procedure Complete_Master is
|
||||
Self_ID : constant Task_Id := STPO.Self;
|
||||
begin
|
||||
pragma Assert (Self_ID.Deferral_Level > 0);
|
||||
pragma Assert
|
||||
(Self_ID.Deferral_Level > 0
|
||||
or else not System.Restrictions.Abort_Allowed);
|
||||
Vulnerable_Complete_Master (Self_ID);
|
||||
end Complete_Master;
|
||||
|
||||
@ -486,7 +486,9 @@ package body System.Tasking.Stages is
|
||||
Self_ID : constant Task_Id := STPO.Self;
|
||||
|
||||
begin
|
||||
pragma Assert (Self_ID.Deferral_Level > 0);
|
||||
pragma Assert
|
||||
(Self_ID.Deferral_Level > 0
|
||||
or else not System.Restrictions.Abort_Allowed);
|
||||
|
||||
Vulnerable_Complete_Task (Self_ID);
|
||||
|
||||
@ -953,9 +955,7 @@ package body System.Tasking.Stages is
|
||||
Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size *
|
||||
SSE.Storage_Offset (Parameters.Sec_Stack_Ratio) / 100;
|
||||
|
||||
Secondary_Stack :
|
||||
aliased SSE.Storage_Array
|
||||
(1 .. Secondary_Stack_Size);
|
||||
Secondary_Stack : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size);
|
||||
|
||||
pragma Warnings (Off);
|
||||
Secondary_Stack_Address : System.Address := Secondary_Stack'Address;
|
||||
@ -969,6 +969,9 @@ package body System.Tasking.Stages is
|
||||
Size :
|
||||
Natural := Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size);
|
||||
|
||||
Overflow_Guard : Natural;
|
||||
-- Size of the overflow guard, used by dynamic stack usage analysis
|
||||
|
||||
pragma Warnings (On);
|
||||
-- Address of secondary stack. In the fixed secondary stack case, this
|
||||
-- value is not modified, causing a warning, hence the bracketing with
|
||||
@ -1004,6 +1007,10 @@ package body System.Tasking.Stages is
|
||||
-- master relationship. If the handler is found, its pointer is stored
|
||||
-- in TH.
|
||||
|
||||
------------------------------
|
||||
-- Search_Fall_Back_Handler --
|
||||
------------------------------
|
||||
|
||||
procedure Search_Fall_Back_Handler (ID : Task_Id) is
|
||||
begin
|
||||
-- If there is a fall back handler, store its pointer for later
|
||||
@ -1030,11 +1037,13 @@ package body System.Tasking.Stages is
|
||||
-- Assume a size of the stack taken at this stage
|
||||
|
||||
if Size < Small_Stack_Limit then
|
||||
Size := Size - Small_Overflow_Guard;
|
||||
Overflow_Guard := Small_Overflow_Guard;
|
||||
else
|
||||
Size := Size - Big_Overflow_Guard;
|
||||
Overflow_Guard := Big_Overflow_Guard;
|
||||
end if;
|
||||
|
||||
Size := Size - Overflow_Guard;
|
||||
|
||||
if not Parameters.Sec_Stack_Dynamic then
|
||||
Self_ID.Common.Compiler_Data.Sec_Stack_Addr :=
|
||||
Secondary_Stack'Address;
|
||||
@ -1048,6 +1057,7 @@ package body System.Tasking.Stages is
|
||||
Self_ID.Common.Task_Image
|
||||
(1 .. Self_ID.Common.Task_Image_Len),
|
||||
Size,
|
||||
Overflow_Guard,
|
||||
SSE.To_Integer (Bottom_Of_Stack'Address));
|
||||
STPO.Unlock_RTS;
|
||||
Fill_Stack (Self_ID.Common.Analyzer);
|
||||
@ -1225,7 +1235,7 @@ package body System.Tasking.Stages is
|
||||
-- since the operation Task_Unlock continued to access the ATCB after
|
||||
-- unlocking, after which the parent was observed to race ahead, deallocate
|
||||
-- the ATCB, and then reallocate it to another task. The call to
|
||||
-- Undefer_Abortion in Task_Unlock by the "terminated" task was overwriting
|
||||
-- Undefer_Abort in Task_Unlock by the "terminated" task was overwriting
|
||||
-- the data of the new task that reused the ATCB! To solve this problem, we
|
||||
-- introduced the new operation Final_Task_Unlock.
|
||||
|
||||
@ -1334,7 +1344,7 @@ package body System.Tasking.Stages is
|
||||
use System.Standard_Library;
|
||||
|
||||
function To_Address is new
|
||||
Unchecked_Conversion (Task_Id, System.Address);
|
||||
Ada.Unchecked_Conversion (Task_Id, System.Address);
|
||||
|
||||
function Tailored_Exception_Information
|
||||
(E : Exception_Occurrence) return String;
|
||||
@ -1492,7 +1502,9 @@ package body System.Tasking.Stages is
|
||||
(Debug.Trace (Self_ID, "V_Complete_Master", 'C'));
|
||||
|
||||
pragma Assert (Self_ID.Common.Wait_Count = 0);
|
||||
pragma Assert (Self_ID.Deferral_Level > 0);
|
||||
pragma Assert
|
||||
(Self_ID.Deferral_Level > 0
|
||||
or else not System.Restrictions.Abort_Allowed);
|
||||
|
||||
-- Count how many active dependent tasks this master currently
|
||||
-- has, and record this in Wait_Count.
|
||||
@ -1559,7 +1571,6 @@ package body System.Tasking.Stages is
|
||||
Write_Lock (Self_ID);
|
||||
|
||||
loop
|
||||
Initialization.Poll_Base_Priority_Change (Self_ID);
|
||||
exit when Self_ID.Common.Wait_Count = 0;
|
||||
|
||||
-- Here is a difference as compared to Complete_Master
|
||||
@ -1659,7 +1670,6 @@ package body System.Tasking.Stages is
|
||||
Write_Lock (Self_ID);
|
||||
|
||||
loop
|
||||
Initialization.Poll_Base_Priority_Change (Self_ID);
|
||||
exit when Self_ID.Common.Wait_Count = 0;
|
||||
Sleep (Self_ID, Master_Phase_2_Sleep);
|
||||
end loop;
|
||||
@ -1813,7 +1823,9 @@ package body System.Tasking.Stages is
|
||||
|
||||
procedure Vulnerable_Complete_Task (Self_ID : Task_Id) is
|
||||
begin
|
||||
pragma Assert (Self_ID.Deferral_Level > 0);
|
||||
pragma Assert
|
||||
(Self_ID.Deferral_Level > 0
|
||||
or else not System.Restrictions.Abort_Allowed);
|
||||
pragma Assert (Self_ID = Self);
|
||||
pragma Assert (Self_ID.Master_Within = Self_ID.Master_of_Task + 1
|
||||
or else
|
||||
@ -1869,7 +1881,7 @@ package body System.Tasking.Stages is
|
||||
|
||||
-- For tasks created by elaboration of task object declarations it
|
||||
-- is called from the finalization code of the Task_Wrapper procedure.
|
||||
-- It is also called from Unchecked_Deallocation, for objects that
|
||||
-- It is also called from Ada.Unchecked_Deallocation, for objects that
|
||||
-- are or contain tasks.
|
||||
|
||||
procedure Vulnerable_Free_Task (T : Task_Id) is
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1991-1994, Florida State University --
|
||||
-- Copyright (C) 1995-2006, AdaCore --
|
||||
-- Copyright (C) 1995-2007, AdaCore --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -41,14 +41,14 @@ with System.Tasking.Initialization;
|
||||
-- used for Defer_Abort
|
||||
-- Undefer_Abort
|
||||
|
||||
with Unchecked_Conversion;
|
||||
with Ada.Unchecked_Conversion;
|
||||
|
||||
package body System.Tasking.Task_Attributes is
|
||||
|
||||
use Task_Primitives.Operations;
|
||||
use Tasking.Initialization;
|
||||
|
||||
function To_Access_Address is new Unchecked_Conversion
|
||||
function To_Access_Address is new Ada.Unchecked_Conversion
|
||||
(Access_Node, Access_Address);
|
||||
-- Store pointer to indirect attribute list
|
||||
|
||||
@ -61,10 +61,15 @@ package body System.Tasking.Task_Attributes is
|
||||
Self_Id : constant Task_Id := Self;
|
||||
|
||||
begin
|
||||
Defer_Abort (Self_Id);
|
||||
-- Defer abort. Note that we use the nestable versions of Defer_Abort
|
||||
-- and Undefer_Abort, because abort can already deferred when this is
|
||||
-- called during finalization, which would cause an assert failure
|
||||
-- in Defer_Abort.
|
||||
|
||||
Defer_Abort_Nestable (Self_Id);
|
||||
Lock_RTS;
|
||||
|
||||
-- Remove this instantiation from the list of all instantiations.
|
||||
-- Remove this instantiation from the list of all instantiations
|
||||
|
||||
declare
|
||||
P : Access_Instance;
|
||||
@ -85,7 +90,8 @@ package body System.Tasking.Task_Attributes is
|
||||
end;
|
||||
|
||||
if X.Index /= 0 then
|
||||
-- Free location of this attribute, for reuse.
|
||||
|
||||
-- Free location of this attribute, for reuse
|
||||
|
||||
In_Use := In_Use and not (2**Natural (X.Index));
|
||||
|
||||
@ -140,7 +146,7 @@ package body System.Tasking.Task_Attributes is
|
||||
X.Deallocate.all (Q);
|
||||
end loop;
|
||||
|
||||
Undefer_Abort (Self_Id);
|
||||
Undefer_Abort_Nestable (Self_Id);
|
||||
|
||||
exception
|
||||
when others =>
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1998-2006, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1998-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -54,6 +54,7 @@ with System.Task_Primitives.Operations;
|
||||
-- Unlock
|
||||
-- Get_Priority
|
||||
-- Wakeup
|
||||
-- Set_Ceiling
|
||||
|
||||
with System.Tasking.Initialization;
|
||||
-- Used for Defer_Abort,
|
||||
@ -64,6 +65,9 @@ pragma Elaborate_All (System.Tasking.Initialization);
|
||||
-- This insures that tasking is initialized if any protected objects are
|
||||
-- created.
|
||||
|
||||
with System.Restrictions;
|
||||
-- Used for Abort_Allowed
|
||||
|
||||
with System.Parameters;
|
||||
-- Used for Single_Lock
|
||||
|
||||
@ -216,13 +220,15 @@ package body System.Tasking.Protected_Objects.Entries is
|
||||
Initialization.Defer_Abort (Self_ID);
|
||||
Initialize_Lock (Init_Priority, Object.L'Access);
|
||||
Initialization.Undefer_Abort (Self_ID);
|
||||
Object.Ceiling := System.Any_Priority (Init_Priority);
|
||||
Object.Owner := Null_Task;
|
||||
Object.Compiler_Info := Compiler_Info;
|
||||
Object.Pending_Action := False;
|
||||
|
||||
Object.Ceiling := System.Any_Priority (Init_Priority);
|
||||
Object.New_Ceiling := System.Any_Priority (Init_Priority);
|
||||
Object.Owner := Null_Task;
|
||||
Object.Compiler_Info := Compiler_Info;
|
||||
Object.Pending_Action := False;
|
||||
Object.Call_In_Progress := null;
|
||||
Object.Entry_Bodies := Entry_Bodies;
|
||||
Object.Find_Body_Index := Find_Body_Index;
|
||||
Object.Entry_Bodies := Entry_Bodies;
|
||||
Object.Find_Body_Index := Find_Body_Index;
|
||||
|
||||
for E in Object.Entry_Queues'Range loop
|
||||
Object.Entry_Queues (E).Head := null;
|
||||
@ -235,7 +241,8 @@ package body System.Tasking.Protected_Objects.Entries is
|
||||
------------------
|
||||
|
||||
procedure Lock_Entries
|
||||
(Object : Protection_Entries_Access; Ceiling_Violation : out Boolean)
|
||||
(Object : Protection_Entries_Access;
|
||||
Ceiling_Violation : out Boolean)
|
||||
is
|
||||
begin
|
||||
if Object.Finalized then
|
||||
@ -264,7 +271,10 @@ package body System.Tasking.Protected_Objects.Entries is
|
||||
-- generated calls must be protected with cleanup handlers to ensure
|
||||
-- that abort is undeferred in all cases.
|
||||
|
||||
pragma Assert (STPO.Self.Deferral_Level > 0);
|
||||
pragma Assert
|
||||
(STPO.Self.Deferral_Level > 0
|
||||
or else not Restrictions.Abort_Allowed);
|
||||
|
||||
Write_Lock (Object.L'Access, Ceiling_Violation);
|
||||
|
||||
-- We are entering in a protected action, so that we increase the
|
||||
@ -401,6 +411,18 @@ package body System.Tasking.Protected_Objects.Entries is
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Before releasing the mutex we must actually update its ceiling
|
||||
-- priority if it has been changed.
|
||||
|
||||
if Object.New_Ceiling /= Object.Ceiling then
|
||||
if Locking_Policy = 'C' then
|
||||
System.Task_Primitives.Operations.Set_Ceiling
|
||||
(Object.L'Access, Object.New_Ceiling);
|
||||
end if;
|
||||
|
||||
Object.Ceiling := Object.New_Ceiling;
|
||||
end if;
|
||||
|
||||
Unlock (Object.L'Access);
|
||||
end Unlock_Entries;
|
||||
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1998-2006, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1998-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -562,7 +562,7 @@ package body System.Tasking.Protected_Objects.Operations is
|
||||
Mode : Call_Modes;
|
||||
Block : out Communication_Block)
|
||||
is
|
||||
Self_ID : constant Task_Id := STPO.Self;
|
||||
Self_ID : constant Task_Id := STPO.Self;
|
||||
Entry_Call : Entry_Call_Link;
|
||||
Initially_Abortable : Boolean;
|
||||
Ceiling_Violation : Boolean;
|
||||
@ -591,14 +591,17 @@ package body System.Tasking.Protected_Objects.Operations is
|
||||
(Program_Error'Identity, "potentially blocking operation");
|
||||
end if;
|
||||
|
||||
Initialization.Defer_Abort (Self_ID);
|
||||
-- Self_ID.Deferral_Level should be 0, except when called from Finalize,
|
||||
-- where abort is already deferred.
|
||||
|
||||
Initialization.Defer_Abort_Nestable (Self_ID);
|
||||
Lock_Entries (Object, Ceiling_Violation);
|
||||
|
||||
if Ceiling_Violation then
|
||||
|
||||
-- Failed ceiling check
|
||||
|
||||
Initialization.Undefer_Abort (Self_ID);
|
||||
Initialization.Undefer_Abort_Nestable (Self_ID);
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
@ -651,7 +654,7 @@ package body System.Tasking.Protected_Objects.Operations is
|
||||
|
||||
Block.Enqueued := False;
|
||||
Block.Cancelled := Entry_Call.State = Cancelled;
|
||||
Initialization.Undefer_Abort (Self_ID);
|
||||
Initialization.Undefer_Abort_Nestable (Self_ID);
|
||||
Entry_Calls.Check_Exception (Self_ID, Entry_Call);
|
||||
return;
|
||||
|
||||
@ -698,7 +701,7 @@ package body System.Tasking.Protected_Objects.Operations is
|
||||
null;
|
||||
end if;
|
||||
|
||||
Initialization.Undefer_Abort (Self_ID);
|
||||
Initialization.Undefer_Abort_Nestable (Self_ID);
|
||||
Entry_Calls.Check_Exception (Self_ID, Entry_Call);
|
||||
end Protected_Entry_Call;
|
||||
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -88,9 +88,9 @@ package System.Tasking.Protected_Objects.Operations is
|
||||
Timeout : Duration;
|
||||
Mode : Delay_Modes;
|
||||
Entry_Call_Successful : out Boolean);
|
||||
-- Same as the Protected_Entry_Call but with time-out specified.
|
||||
-- This routines is used when we do not use ATC mechanism to implement
|
||||
-- timed entry calls.
|
||||
-- Same as the Protected_Entry_Call but with time-out specified.
|
||||
-- This routines is used when we do not use ATC mechanism to implement
|
||||
-- timed entry calls.
|
||||
|
||||
procedure Service_Entries (Object : Entries.Protection_Entries_Access);
|
||||
pragma Inline (Service_Entries);
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1998-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1998-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -548,10 +548,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||
Uninterpreted_Data : System.Address;
|
||||
Mode : Call_Modes)
|
||||
is
|
||||
Self_Id : constant Task_Id := STPO.Self;
|
||||
Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1);
|
||||
Ceiling_Violation : Boolean;
|
||||
|
||||
Self_Id : constant Task_Id := STPO.Self;
|
||||
Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1);
|
||||
begin
|
||||
-- If pragma Detect_Blocking is active then Program_Error must be
|
||||
-- raised if this potentially blocking operation is called from a
|
||||
@ -564,11 +562,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||
(Program_Error'Identity, "potentially blocking operation");
|
||||
end if;
|
||||
|
||||
STPO.Write_Lock (Object.L'Access, Ceiling_Violation);
|
||||
|
||||
if Ceiling_Violation then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
Lock_Entry (Object);
|
||||
|
||||
Entry_Call.Mode := Mode;
|
||||
Entry_Call.State := Now_Abortable;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user