mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-21 14:30:59 +08:00
Code Issues Packages Projects Releases Wiki Activity

rtsfind.ads: Add RE_Lock_Read_Only into rtsfind circuitry.

Browse Source 
2011-09-27  Pascal Obry  <obry@adacore.com>

	* rtsfind.ads: Add RE_Lock_Read_Only into rtsfind circuitry.
	(RE_Id): Add RE_Lock_Read_Only.
	(RE_Unit_Table): Likewise.
	* sem_prag.adb (Process_Convention): Change Pragma_Locking_Policy
	to lift restriction on first character. Handle now the
	Name_Concurrent_Readers_Locking where policy character is set to
	'R'.
	* snames.ads-tmpl (Name_Concurrent_Readers_Locking): New
	constant.
	* exp_ch9.adb (Build_Protected_Subprogram_Body): Generate a
	read only lock for function in protected object.
	* s-taprob.ads (Lock_Read_Only): Remove obsolete comment as
	this routine is now used.

From-SVN: r179248
This commit is contained in:
Pascal Obry 2011-09-27 09:16:57 +00:00 committed by Arnaud Charlet
parent 48acf1b78b
commit 343250a6d5
7 changed files with 42 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2011-09-27 Pascal Obry <obry@adacore.com>
* rtsfind.ads: Add RE_Lock_Read_Only into rtsfind circuitry.
(RE_Id): Add RE_Lock_Read_Only.
(RE_Unit_Table): Likewise.
* sem_prag.adb (Process_Convention): Change Pragma_Locking_Policy
to lift restriction on first character. Handle now the
Name_Concurrent_Readers_Locking where policy character is set to
'R'.
* snames.ads-tmpl (Name_Concurrent_Readers_Locking): New
constant.
* exp_ch9.adb (Build_Protected_Subprogram_Body): Generate a
read only lock for function in protected object.
* s-taprob.ads (Lock_Read_Only): Remove obsolete comment as
this routine is now used.
2011-09-26 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
* s-atocou-x86.adb (Decrement): Use %;.

7
gcc/ada/exp_ch9.adb
View File

@ -3243,6 +3243,7 @@ package body Exp_Ch9 is
Stmts : List_Id;
Object_Parm : Node_Id;
Exc_Safe : Boolean;
Lock_Kind : RE_Id;
function Is_Exception_Safe (Subprogram : Node_Id) return Boolean;
-- Tell whether a given subprogram cannot raise an exception
@ -3389,12 +3390,16 @@ package body Exp_Ch9 is
Parameter_Associations => Uactuals));
end if;
Lock_Kind := RE_Lock_Read_Only;
else
Unprot_Call :=
Make_Procedure_Call_Statement (Loc,
Name =>
Make_Identifier (Loc, Chars (Defining_Unit_Name (N_Op_Spec))),
Parameter_Associations => Uactuals);
Lock_Kind := RE_Lock;
end if;
-- Wrap call in block that will be covered by an at_end handler
@ -3419,7 +3424,7 @@ package body Exp_Ch9 is
Service_Name := New_Reference_To (RTE (RE_Service_Entry), Loc);
when System_Tasking_Protected_Objects =>
Lock_Name := New_Reference_To (RTE (RE_Lock), Loc);
Lock_Name := New_Reference_To (RTE (Lock_Kind), Loc);
Service_Name := New_Reference_To (RTE (RE_Unlock), Loc);
when others =>

5
gcc/ada/gnat_rm.texi
View File

@ -7916,8 +7916,9 @@ Not followed. This implementation is not targeted to such a domain.
The implementation should use names that end with @samp{_Locking} for
locking policies defined by the implementation.
@end cartouche
Followed. A single implementation-defined locking policy is defined,
whose name (@code{Inheritance_Locking}) follows this suggestion.
Followed. Two implementation-defined locking policies are defined,
whose names (@code{Inheritance_Locking} and
@code{Concurrent_Readers_Locking}) follow this suggestion.
@cindex Entry queuing policies
@unnumberedsec D.4(16): Entry Queuing Policies

2
gcc/ada/rtsfind.ads
View File

@ -1653,6 +1653,7 @@ package Rtsfind is
RE_Initialize_Protection, -- System.Tasking.Protected_Objects
RE_Finalize_Protection, -- System.Tasking.Protected_Objects
RE_Lock, -- System.Tasking.Protected_Objects
RE_Lock_Read_Only, -- System.Tasking.Protected_Objects
RE_Get_Ceiling, -- System.Tasking.Protected_Objects
RE_Set_Ceiling, -- System.Tasking.Protected_Objects
RE_Unlock, -- System.Tasking.Protected_Objects
@ -2883,6 +2884,7 @@ package Rtsfind is
RE_Initialize_Protection => System_Tasking_Protected_Objects,
RE_Finalize_Protection => System_Tasking_Protected_Objects,
RE_Lock => System_Tasking_Protected_Objects,
RE_Lock_Read_Only => System_Tasking_Protected_Objects,
RE_Get_Ceiling => System_Tasking_Protected_Objects,
RE_Set_Ceiling => System_Tasking_Protected_Objects,
RE_Unlock => System_Tasking_Protected_Objects,

6
gcc/ada/s-taprob.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -193,10 +193,6 @@ package System.Tasking.Protected_Objects is
-- has been made by the caller. Other calls to Lock_Read_Only may (but
-- need not) return before the call to Unlock, and the corresponding
-- callers will also own the lock for read access.
--
-- Note: we are not currently using this interface, it is provided
-- for possible future use. At the current time, everyone uses Lock
-- for both read and write locks.
procedure Set_Ceiling
(Object : Protection_Access;

15
gcc/ada/sem_prag.adb
View File

@ -10834,16 +10834,23 @@ package body Sem_Prag is
-- pragma Locking_Policy (policy_IDENTIFIER);
when Pragma_Locking_Policy => declare
LP : Character;
subtype LP_Range is Name_Id
range First_Locking_Policy_Name .. Last_Locking_Policy_Name;
LP_Val : LP_Range;
LP : Character;
begin
Check_Ada_83_Warning;
Check_Arg_Count (1);
Check_No_Identifiers;
Check_Arg_Is_Locking_Policy (Arg1);
Check_Valid_Configuration_Pragma;
Get_Name_String (Chars (Get_Pragma_Arg (Arg1)));
LP := Fold_Upper (Name_Buffer (1));
LP_Val := Chars (Get_Pragma_Arg (Arg1));
case LP_Val is
when Name_Ceiling_Locking => LP := 'C';
when Name_Inheritance_Locking => LP := 'I';
when Name_Concurrent_Readers_Locking => LP := 'R';
end case;
if Locking_Policy /= ' '
and then Locking_Policy /= LP

8
gcc/ada/snames.ads-tmpl
View File

@ -909,13 +909,10 @@ package Snames is
-- Names of recognized locking policy identifiers
-- Note: policies are identified by the first character of the
-- name (e.g. C for Ceiling_Locking). If new policy names are added,
-- the first character must be distinct.
First_Locking_Policy_Name : constant Name_Id := N + $;
Name_Ceiling_Locking : constant Name_Id := N + $;
Name_Inheritance_Locking : constant Name_Id := N + $;
Name_Concurrent_Readers_Locking : constant Name_Id := N + $; -- GNAT
Last_Locking_Policy_Name : constant Name_Id := N + $;
-- Names of recognized queuing policy identifiers
@ -1500,7 +1497,8 @@ package Snames is
type Locking_Policy_Id is (
Locking_Policy_Inheritance_Locking,
Locking_Policy_Ceiling_Locking);
Locking_Policy_Ceiling_Locking,
Locking_Policy_Concurrent_Readers_Locking);
---------------------------
-- Pragma ID Definitions --