[Ada] AI-327
Arnaud Charlet
charlet@adacore.com
Tue Oct 31 20:00:00 GMT 2006
Tested on i686-linux, committed on trunk.
These patches add support in the frontend for a new mechanism
defined in Ada 2005 that enables the ceiling priority of a
protected object to be changed by assignment to the new attribute
Priority within a protected operation of the object.
For further information read:
http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00327.TXT?rev=1.18
2006-10-31 Javier Miranda <miranda@adacore.com>
* s-tpoben.ads, s-tpoben.adb, s-taprob.ads, s-taprob.adb
(Get_Ceiling): New subprogram that returns
the ceiling priority of the protected object.
(Set_Ceiling): New subprogram that sets the new ceiling priority of
the protected object.
* s-tarest.adb: (Create_Restricted_Task): Fix potential CE.
* s-taskin.ads, s-taskin.adb: (Storage_Size): New function.
-------------- next part --------------
Index: s-tpoben.ads
===================================================================
--- s-tpoben.ads (revision 118179)
+++ s-tpoben.ads (working copy)
@@ -7,7 +7,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- --
@@ -93,6 +93,16 @@ package System.Tasking.Protected_Objects
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.
@@ -142,6 +152,10 @@ package System.Tasking.Protected_Objects
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
@@ -183,6 +197,11 @@ package System.Tasking.Protected_Objects
-- 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
Index: s-tpoben.adb
===================================================================
--- s-tpoben.adb (revision 118179)
+++ s-tpoben.adb (working copy)
@@ -7,7 +7,7 @@
-- --
-- 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- --
@@ -162,6 +162,16 @@ package body System.Tasking.Protected_Ob
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 --
-------------------------------------
@@ -349,6 +359,17 @@ package body System.Tasking.Protected_Ob
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 --
--------------------
Index: s-taprob.ads
===================================================================
--- s-taprob.ads (revision 118179)
+++ s-taprob.ads (working copy)
@@ -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- --
@@ -45,7 +45,7 @@
-- 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;
@@ -172,6 +172,10 @@ package System.Tasking.Protected_Objects
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);
@@ -196,6 +200,11 @@ package System.Tasking.Protected_Objects
-- 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
@@ -212,6 +221,16 @@ private
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.
Index: s-taprob.adb
===================================================================
--- s-taprob.adb (revision 118179)
+++ s-taprob.adb (working copy)
@@ -7,7 +7,7 @@
-- 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- --
@@ -81,9 +81,20 @@ package body System.Tasking.Protected_Ob
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 --
----------
@@ -199,6 +210,17 @@ package body System.Tasking.Protected_Ob
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 --
------------
Index: s-tarest.adb
===================================================================
--- s-tarest.adb (revision 118179)
+++ s-tarest.adb (working copy)
@@ -473,6 +473,7 @@ package body System.Tasking.Restricted.S
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
@@ -515,10 +516,11 @@ package body System.Tasking.Restricted.S
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);
Index: s-taskin.ads
===================================================================
--- s-taskin.ads (revision 118179)
+++ s-taskin.ads (working copy)
@@ -377,6 +377,12 @@ package System.Tasking is
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 --
----------------------------------------------
Index: s-taskin.adb
===================================================================
--- s-taskin.adb (revision 118179)
+++ s-taskin.adb (working copy)
@@ -66,6 +66,17 @@ package body System.Tasking is
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 --
---------------------
More information about the Gcc-patches
mailing list