-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2005, AdaCore --
+-- Copyright (C) 1995-2006, 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- --
Initialize_Lock (Init_Priority, Object.L'Access);
Object.Ceiling := System.Any_Priority (Init_Priority);
+ Object.New_Ceiling := System.Any_Priority (Init_Priority);
Object.Owner := Null_Task;
end Initialize_Protection;
+ -----------------
+ -- Get_Ceiling --
+ -----------------
+
+ function Get_Ceiling
+ (Object : Protection_Access) return System.Any_Priority is
+ begin
+ return Object.New_Ceiling;
+ end Get_Ceiling;
+
----------
-- Lock --
----------
end if;
end Lock_Read_Only;
+ -----------------
+ -- Set_Ceiling --
+ -----------------
+
+ procedure Set_Ceiling
+ (Object : Protection_Access;
+ Prio : System.Any_Priority) is
+ begin
+ Object.New_Ceiling := Prio;
+ end Set_Ceiling;
+
------------
-- Unlock --
------------
-- --
-- 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- --
-- Note: the compiler generates direct calls to this interface, via Rtsfind.
-- Any changes to this interface may require corresponding compiler changes
--- in exp_ch9.adb and possibly exp_ch7.adb
+-- in exp_ch9.adb and possibly exp_ch7.adb and exp_attr.adb
package System.Tasking.Protected_Objects is
pragma Elaborate_Body;
Null_PO : constant Protection_Access := null;
+ function Get_Ceiling
+ (Object : Protection_Access) return System.Any_Priority;
+ -- Returns the new ceiling priority of the protected object
+
procedure Initialize_Protection
(Object : Protection_Access;
Ceiling_Priority : Integer);
-- for possible future use. At the current time, everyone uses Lock
-- for both read and write locks.
+ procedure Set_Ceiling
+ (Object : Protection_Access;
+ Prio : System.Any_Priority);
+ -- Sets the new ceiling priority of the protected object
+
procedure Unlock (Object : Protection_Access);
-- Relinquish ownership of the lock for the object represented by
-- the Object parameter. If this ownership was for write access, or
Ceiling : System.Any_Priority;
-- Ceiling priority associated to the protected object
+ New_Ceiling : System.Any_Priority;
+ -- New ceiling priority associated to the protected object. In case
+ -- of assignment of a new ceiling priority to the protected object the
+ -- frontend generates a call to set_ceiling to save the new value in
+ -- this field. After such assignment this value can be read by means
+ -- of the 'Priority attribute, which generates a call to get_ceiling.
+ -- However, the ceiling of the protected object will not be changed
+ -- until completion of the protected action in which the assignment
+ -- has been executed (AARM D.5.2 (10/2)).
+
Owner : Task_Id;
-- This field contains the protected object's owner. Null_Task
-- indicates that the protected object is not currently being used.
Self_ID : constant Task_Id := STPO.Self;
Base_Priority : System.Any_Priority;
Success : Boolean;
+ Len : Integer;
begin
-- Stack is not preallocated on this target, so that Stack_Address must
Created_Task.Entry_Calls (1).Self := Created_Task;
- Created_Task.Common.Task_Image_Len :=
+ Len :=
Integer'Min (Created_Task.Common.Task_Image'Length, Task_Image'Length);
- Created_Task.Common.Task_Image
- (1 .. Created_Task.Common.Task_Image_Len) := Task_Image;
+ Created_Task.Common.Task_Image_Len := Len;
+ Created_Task.Common.Task_Image (1 .. Len) :=
+ Task_Image (Task_Image'First .. Task_Image'First + Len - 1);
Unlock (Self_ID);
function Self return Task_Id renames STPO.Self;
+ ------------------
+ -- Storage_Size --
+ ------------------
+
+ function Storage_Size (T : Task_Id) return System.Parameters.Size_Type is
+ begin
+ return
+ System.Parameters.Size_Type
+ (T.Common.Compiler_Data.Pri_Stack_Info.Size);
+ end Storage_Size;
+
---------------------
-- Initialize_ATCB --
---------------------
pragma Inline (Detect_Blocking);
-- Return whether the Detect_Blocking pragma is enabled
+ function Storage_Size (T : Task_Id) return System.Parameters.Size_Type;
+ -- Retrieve from the TCB of the task the allocated size of its stack,
+ -- either the system default or the size specified by a pragma. This
+ -- is in general a non-static value that can depend on discriminants
+ -- of the task.
+
----------------------------------------------
-- Ada_Task_Control_Block (ATCB) definition --
----------------------------------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-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- --
STPO.Finalize_Lock (Object.L'Unrestricted_Access);
end Finalize;
+ -----------------
+ -- Get_Ceiling --
+ -----------------
+
+ function Get_Ceiling
+ (Object : Protection_Entries_Access) return System.Any_Priority is
+ begin
+ return Object.New_Ceiling;
+ end Get_Ceiling;
+
-------------------------------------
-- Has_Interrupt_Or_Attach_Handler --
-------------------------------------
end if;
end Lock_Read_Only_Entries;
+ -----------------
+ -- Set_Ceiling --
+ -----------------
+
+ procedure Set_Ceiling
+ (Object : Protection_Entries_Access;
+ Prio : System.Any_Priority) is
+ begin
+ Object.New_Ceiling := Prio;
+ end Set_Ceiling;
+
--------------------
-- Unlock_Entries --
--------------------
-- --
-- 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- --
Ceiling : System.Any_Priority;
-- Ceiling priority associated with the protected object
+ New_Ceiling : System.Any_Priority;
+ -- New ceiling priority associated to the protected object. In case
+ -- of assignment of a new ceiling priority to the protected object the
+ -- frontend generates a call to set_ceiling to save the new value in
+ -- this field. After such assignment this value can be read by means
+ -- of the 'Priority attribute, which generates a call to get_ceiling.
+ -- However, the ceiling of the protected object will not be changed
+ -- until completion of the protected action in which the assignment
+ -- has been executed (AARM D.5.2 (10/2)).
+
Owner : Task_Id;
-- This field contains the protected object's owner. Null_Task
-- indicates that the protected object is not currently being used.
function To_Protection is
new Unchecked_Conversion (System.Address, Protection_Entries_Access);
+ function Get_Ceiling
+ (Object : Protection_Entries_Access) return System.Any_Priority;
+ -- Returns the new ceiling priority of the protected object
+
function Has_Interrupt_Or_Attach_Handler
(Object : Protection_Entries_Access) return Boolean;
-- Returns True if an Interrupt_Handler or Attach_Handler pragma applies
-- possible future use. At the current time, everyone uses Lock for both
-- read and write locks.
+ procedure Set_Ceiling
+ (Object : Protection_Entries_Access;
+ Prio : System.Any_Priority);
+ -- Sets the new ceiling priority of the protected object
+
procedure Unlock_Entries (Object : Protection_Entries_Access);
-- Relinquish ownership of the lock for the object represented by the
-- Object parameter. If this ownership was for write access, or if it was