-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 1991-2001 Florida State University --
+-- Copyright (C) 1991-1994, Florida State University --
+-- Copyright (C) 1995-2004, Ada Core Technologies --
-- --
-- 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- --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
--- GNARL was developed by the GNARL team at Florida State University. It is --
--- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
--- State University (http://www.gnat.com). --
+-- GNARL was developed by the GNARL team at Florida State University. --
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
with System.Task_Primitives.Operations;
-- used for Write_Lock
-- Unlock
+-- Self
with System.Parameters;
-- used for Runtime_Traces
with System.Traces;
-- used for Send_Trace_Info
+with System.Soft_Links.Tasking;
+-- Used for Init_Tasking_Soft_Links
+
package body System.Tasking.Protected_Objects is
use System.Task_Primitives.Operations;
procedure Lock (Object : Protection_Access) is
Ceiling_Violation : Boolean;
+
begin
-- The lock is made without defering abortion.
if Ceiling_Violation then
raise Program_Error;
end if;
+
+ -- We are entering in a protected action, so that we increase the
+ -- protected object nesting level (if pragma Detect_Blocking is
+ -- active).
+
+ if Detect_Blocking then
+ declare
+ Self_Id : constant Task_Id := Self;
+ begin
+ Self_Id.Common.Protected_Action_Nesting :=
+ Self_Id.Common.Protected_Action_Nesting + 1;
+ end;
+ end if;
end Lock;
--------------------
procedure Lock_Read_Only (Object : Protection_Access) is
Ceiling_Violation : Boolean;
+
begin
Read_Lock (Object.L'Access, Ceiling_Violation);
if Ceiling_Violation then
raise Program_Error;
end if;
+
+ -- We are entering in a protected action, so that we increase the
+ -- protected object nesting level (if pragma Detect_Blocking is
+ -- active).
+
+ if Detect_Blocking then
+ declare
+ Self_Id : constant Task_Id := Self;
+ begin
+ Self_Id.Common.Protected_Action_Nesting :=
+ Self_Id.Common.Protected_Action_Nesting + 1;
+ end;
+ end if;
end Lock_Read_Only;
------------
procedure Unlock (Object : Protection_Access) is
begin
+ -- We are exiting from a protected action, so that we decrease the
+ -- protected object nesting level (if pragma Detect_Blocking is
+ -- active).
+
+ if Detect_Blocking then
+ declare
+ Self_Id : constant Task_Id := Self;
+
+ begin
+ -- Cannot call this procedure without being within a protected
+ -- action.
+
+ pragma Assert (Self_Id.Common.Protected_Action_Nesting > 0);
+
+ Self_Id.Common.Protected_Action_Nesting :=
+ Self_Id.Common.Protected_Action_Nesting - 1;
+ end;
+ end if;
+
Unlock (Object.L'Access);
if Parameters.Runtime_Traces then
end if;
end Unlock;
+begin
+ -- Ensure that tasking soft links are set when using protected objects
+
+ System.Soft_Links.Tasking.Init_Tasking_Soft_Links;
end System.Tasking.Protected_Objects;