* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@179248
138bc75d-0d04-0410-961f-
82ee72b054a4
+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 %;.
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
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
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 =>
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
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
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,
-- --
-- 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- --
-- 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;
-- 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
-- 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
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 --
OSDN Git Service
