Skip to content

R
riscv-gcc-1
Commit 15b540be by Javier Miranda Committed by Arnaud Charlet
Options

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.

From-SVN: r118317
parent d5ef47fb
Showing with 108 additions and 8 deletions
gcc/ada/s-taprob.adb
......@@ -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_Objects is
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_Objects is
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 --
------------
......
gcc/ada/s-taprob.ads
......@@ -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 is
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 is
-- 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.
......
gcc/ada/s-tarest.adb
......@@ -473,6 +473,7 @@ package body System.Tasking.Restricted.Stages is
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.Stages is
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);
......
gcc/ada/s-taskin.adb
......@@ -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 --
---------------------
......
gcc/ada/s-taskin.ads
......@@ -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 --
----------------------------------------------
......
gcc/ada/s-tpoben.adb
......@@ -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_Objects.Entries is
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_Objects.Entries is
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 --
--------------------
......
gcc/ada/s-tpoben.ads
......@@ -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.Entries is
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.Entries is
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.Entries is
-- 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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment