2011-09-27 Pascal Obry <obry@adacore.com>
+ * s-taprop.ads (Initialize_Lock)[RW_Lock]: New spec for r/w lock.
+ (Finalize_Lock)[RW_Lock]: Likewise.
+ (Write_Lock)[RW_Lock]: Likewise.
+ (Unlock)[RW_Lock]: Likewise.
+ (Read_Lock): Define L as RW_Lock (instead of Lock).
+ * s-taprop-linux.adb (Initialize_Lock)[RW_Lock]: New
+ routine for r/w lock.
+ (Finalize_Lock)[RW_Lock]: Likewise.
+ (Write_Lock)[RW_Lock]: Likewise.
+ (Unlock)[RW_Lock]: Likewise.
+ (Read_Lock): Define L as RW_Lock (instead of Lock).
+
+ * s-taprop-vxworks.adb, s-taprop-tru64.adb, s-taprop-vms.adb,
+ s-taprop-mingw.adb, s-taprop-solaris.adb, s-taprop-irix.adb,
+ s-taprop-hpux-dce.adb, s-taprop-dummy.adb, s-taprop-posix.adb
+ (Initialize_Lock)[RW_Lock]: Same implementation as corresponding
+ routine for standard lock.
+ (Finalize_Lock)[RW_Lock]: Likewise.
+ (Write_Lock)[RW_Lock]: Likewise.
+ (Unlock)[RW_Lock]: Likewise.
+ (Read_Lock): Define L as RW_Lock (instead of Lock).
+ * s-taprob.ads, s-tpoben.ads (Protection): Add RWL (RW_Lock)
+ in the record definition.
+ * s-taprob.adb, s-taproben.adb (Finalize_Protection): Use r/w
+ lock for 'R' locking policy.
+ (Initialize_Protection): Likewise.
+ (Lock): Likewise.
+ (Lock_Read_Only): Likewise.
+ (Unlock): Likewise.
+ * s-taspri-posix.ads (RW_Lock): New type defined as
+ OS_Interface.pthread_rwlock_t.
+
+ * s-taspri-vxworks.ads, s-taspri-posix-noaltstack.ads,
+ s-taspri-mingw.ads, s-taspri-solaris.ads, s-taspri-dummy.ads,
+ s-taspri-posix.ads, s-taspri-vms.ads, s-taspri-hpux-dce.ads,
+ s-taspri-tru64.ads (RW_Lock): New type defined as alias to Lock.
+
+2011-09-27 Pascal Obry <obry@adacore.com>
+
* exp_ch9.adb, s-taspri-posix.ads: Minor reformatting.
2011-09-27 Pascal Obry <obry@adacore.com>
in a pragma @code{Locking_Policy}. See D.3(4).
@end cartouche
@noindent
-The only implementation defined policy permitted in GNAT is
-@code{Inheritance_Locking}. On targets that support this policy, locking
-is implemented by inheritance, i.e.@: the task owning the lock operates
+The two implementation defined policies permitted in GNAT are
+@code{Inheritance_Locking} and @code{Conccurent_Readers_Locking}. On
+targets that support the @code{Inheritance_Locking} policy, locking is
+implemented by inheritance, i.e.@: the task owning the lock operates
at a priority equal to the highest priority of any task currently
-requesting the lock.
+requesting the lock. On targets that support the
+@code{Conccurent_Readers_Locking} policy, locking is implemented with a
+read/write lock allowing multiple propected object functions to enter
+concurrently.
@sp 1
@cartouche
-- --
-- B o d y --
-- --
--- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2010, AdaCore --
+-- Copyright (C) 1991-1994, Florida State University --
+-- Copyright (C) 1995-2011, AdaCore --
-- --
-- GNAT 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- --
procedure Finalize_Protection (Object : in out Protection) is
begin
- Finalize_Lock (Object.L'Unrestricted_Access);
+ if Locking_Policy = 'R' then
+ Finalize_Lock (Object.RWL'Unrestricted_Access);
+ else
+ Finalize_Lock (Object.L'Unrestricted_Access);
+ end if;
end Finalize_Protection;
---------------------------
Init_Priority := System.Priority'Last;
end if;
- Initialize_Lock (Init_Priority, Object.L'Access);
+ if Locking_Policy = 'R' then
+ Initialize_Lock (Init_Priority, Object.RWL'Access);
+ else
+ Initialize_Lock (Init_Priority, Object.L'Access);
+ end if;
Object.Ceiling := System.Any_Priority (Init_Priority);
Object.New_Ceiling := System.Any_Priority (Init_Priority);
Object.Owner := Null_Task;
raise Program_Error;
end if;
- Write_Lock (Object.L'Access, Ceiling_Violation);
+ if Locking_Policy = 'R' then
+ Write_Lock (Object.RWL'Access, Ceiling_Violation);
+ else
+ Write_Lock (Object.L'Access, Ceiling_Violation);
+ end if;
if Parameters.Runtime_Traces then
Send_Trace_Info (PO_Lock);
raise Program_Error;
end if;
- Read_Lock (Object.L'Access, Ceiling_Violation);
+ if Locking_Policy = 'R' then
+ Read_Lock (Object.RWL'Access, Ceiling_Violation);
+ else
+ Write_Lock (Object.L'Access, Ceiling_Violation);
+ end if;
if Parameters.Runtime_Traces then
Send_Trace_Info (PO_Lock);
Object.Ceiling := Object.New_Ceiling;
end if;
- Unlock (Object.L'Access);
+ if Locking_Policy = 'R' then
+ Unlock (Object.RWL'Access);
+ else
+ Unlock (Object.L'Access);
+ end if;
if Parameters.Runtime_Traces then
Send_Trace_Info (PO_Unlock);
L : aliased Task_Primitives.Lock;
-- Lock used to ensure mutual exclusive access to the protected object
+ RWL : aliased Task_Primitives.RW_Lock;
+ -- Lock used to support conccurent readers to the protected object
+
Ceiling : System.Any_Priority;
-- Ceiling priority associated to the protected object
null;
end Finalize_Lock;
+ procedure Finalize_Lock (L : not null access RW_Lock) is
+ begin
+ null;
+ end Finalize_Lock;
+
procedure Finalize_Lock (L : not null access RTS_Lock) is
begin
null;
end Initialize_Lock;
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock)
+ is
+ begin
+ null;
+ end Initialize_Lock;
+
+ procedure Initialize_Lock
(L : not null access RTS_Lock; Level : Lock_Level) is
begin
null;
---------------
procedure Read_Lock
- (L : not null access Lock;
+ (L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
null;
end Unlock;
+ procedure Unlock (L : not null access RW_Lock) is
+ begin
+ null;
+ end Unlock;
+
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
end Write_Lock;
procedure Write_Lock
+ (L : not null access RW_Lock;
+ Ceiling_Violation : out Boolean)
+ is
+ begin
+ Ceiling_Violation := False;
+ end Write_Lock;
+
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
end Initialize_Lock;
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock)
+ is
+ begin
+ Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
+ end Initialize_Lock;
+
+ procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
pragma Assert (Result = 0);
end Finalize_Lock;
+ procedure Finalize_Lock (L : not null access RW_Lock) is
+ begin
+ Finalize_Lock (Lock (L.all)'Unrestricted_Access);
+ end Finalize_Lock;
+
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
end Write_Lock;
procedure Write_Lock
+ (L : not null access RW_Lock;
+ Ceiling_Violation : out Boolean)
+ is
+ begin
+ Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
+ end Write_Lock;
+
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
---------------
procedure Read_Lock
- (L : not null access Lock;
+ (L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
pragma Assert (Result = 0);
end Unlock;
+ procedure Unlock (L : not null access RW_Lock) is
+ begin
+ Unlock (Lock (L.all)'Unrestricted_Access);
+ end Unlock;
+
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
end Initialize_Lock;
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock)
+ is
+ begin
+ Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
+ end Initialize_Lock;
+
+ procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
pragma Assert (Result = 0);
end Finalize_Lock;
+ procedure Finalize_Lock (L : not null access RW_Lock) is
+ begin
+ Finalize_Lock (Lock (L.all)'Unrestricted_Access);
+ end Finalize_Lock;
+
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
end Write_Lock;
procedure Write_Lock
+ (L : not null access RW_Lock; Ceiling_Violation : out Boolean)
+ is
+ begin
+ Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
+ end Write_Lock;
+
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
---------------
procedure Read_Lock
- (L : not null access Lock; Ceiling_Violation : out Boolean) is
+ (L : not null access RW_Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
pragma Assert (Result = 0);
end Unlock;
+ procedure Unlock (L : not null access RW_Lock) is
+ begin
+ Unlock (Lock (L.all)'Unrestricted_Access);
+ end Unlock;
+
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
end Initialize_Lock;
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock)
+ is
+ pragma Unreferenced (Prio);
+
+ RWlock_Attr : aliased pthread_rwlockattr_t;
+ Result : Interfaces.C.int;
+
+ begin
+ -- Set the rwlock to prefer writer to avoid writers starvation
+
+ Result := pthread_rwlockattr_init (RWlock_Attr'Access);
+ pragma Assert (Result = 0);
+
+ Result := pthread_rwlockattr_setkind_np
+ (RWlock_Attr'Access, PTHREAD_RWLOCK_PREFER_WRITER_NONRECURSIVE_NP);
+ pragma Assert (Result = 0);
+
+ Result := pthread_rwlock_init (L, RWlock_Attr'Access);
+
+ pragma Assert (Result = 0 or else Result = ENOMEM);
+
+ if Result = ENOMEM then
+ raise Storage_Error with "Failed to allocate a lock";
+ end if;
+ end Initialize_Lock;
+
+ procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
pragma Assert (Result = 0);
end Finalize_Lock;
+ procedure Finalize_Lock (L : not null access RW_Lock) is
+ Result : Interfaces.C.int;
+ begin
+ Result := pthread_rwlock_destroy (L);
+ pragma Assert (Result = 0);
+ end Finalize_Lock;
+
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
end Write_Lock;
procedure Write_Lock
+ (L : not null access RW_Lock;
+ Ceiling_Violation : out Boolean)
+ is
+ Result : Interfaces.C.int;
+ begin
+ Result := pthread_rwlock_wrlock (L);
+ Ceiling_Violation := Result = EINVAL;
+
+ -- Assume the cause of EINVAL is a priority ceiling violation
+
+ pragma Assert (Result = 0 or else Result = EINVAL);
+ end Write_Lock;
+
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
---------------
procedure Read_Lock
- (L : not null access Lock;
+ (L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
+ Result : Interfaces.C.int;
begin
- Write_Lock (L, Ceiling_Violation);
+ Result := pthread_rwlock_rdlock (L);
+ Ceiling_Violation := Result = EINVAL;
+
+ -- Assume the cause of EINVAL is a priority ceiling violation
+
+ pragma Assert (Result = 0 or else Result = EINVAL);
end Read_Lock;
------------
pragma Assert (Result = 0);
end Unlock;
+ procedure Unlock (L : not null access RW_Lock) is
+ Result : Interfaces.C.int;
+ begin
+ Result := pthread_rwlock_unlock (L);
+ pragma Assert (Result = 0);
+ end Unlock;
+
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
end Initialize_Lock;
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock)
+ is
+ begin
+ Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
+ end Initialize_Lock;
+
+ procedure Initialize_Lock
(L : not null access RTS_Lock; Level : Lock_Level)
is
pragma Unreferenced (Level);
DeleteCriticalSection (L.Mutex'Access);
end Finalize_Lock;
+ procedure Finalize_Lock (L : not null access RW_Lock) is
+ begin
+ Finalize_Lock (Lock (L.all)'Unrestricted_Access);
+ end Finalize_Lock;
+
procedure Finalize_Lock (L : not null access RTS_Lock) is
begin
DeleteCriticalSection (L);
end Write_Lock;
procedure Write_Lock
+ (L : not null access RW_Lock; Ceiling_Violation : out Boolean) is
+ begin
+ Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
+ end Write_Lock;
+
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
---------------
procedure Read_Lock
- (L : not null access Lock; Ceiling_Violation : out Boolean) is
+ (L : not null access RW_Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
LeaveCriticalSection (L.Mutex'Access);
end Unlock;
+ procedure Unlock (L : not null access RW_Lock) is
+ begin
+ Unlock (Lock (L.all)'Unrestricted_Access);
+ end Unlock;
+
procedure Unlock
(L : not null access RTS_Lock; Global_Lock : Boolean := False) is
begin
end Initialize_Lock;
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock)
+ is
+ begin
+ Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
+ end Initialize_Lock;
+
+ procedure Initialize_Lock
(L : not null access RTS_Lock; Level : Lock_Level)
is
pragma Unreferenced (Level);
pragma Assert (Result = 0);
end Finalize_Lock;
+ procedure Finalize_Lock (L : not null access RW_Lock) is
+ begin
+ Finalize_Lock (Lock (L.all)'Unrestricted_Access);
+ end Finalize_Lock;
+
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
end Write_Lock;
procedure Write_Lock
+ (L : not null access RW_Lock; Ceiling_Violation : out Boolean)
+ is
+ begin
+ Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
+ end Write_Lock;
+
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
---------------
procedure Read_Lock
- (L : not null access Lock; Ceiling_Violation : out Boolean) is
+ (L : not null access RW_Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
pragma Assert (Result = 0);
end Unlock;
+ procedure Unlock (L : not null access RW_Lock) is
+ begin
+ Unlock (Lock (L.all)'Unrestricted_Access);
+ end Unlock;
+
procedure Unlock
(L : not null access RTS_Lock; Global_Lock : Boolean := False)
is
end Initialize_Lock;
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock)
+ is
+ begin
+ Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
+ end Initialize_Lock;
+
+ procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
pragma Assert (Result = 0);
end Finalize_Lock;
+ procedure Finalize_Lock (L : not null access RW_Lock) is
+ begin
+ Finalize_Lock (Lock (L.all)'Unrestricted_Access);
+ end Finalize_Lock;
+
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
end Write_Lock;
procedure Write_Lock
+ (L : not null access RW_Lock;
+ Ceiling_Violation : out Boolean)
+ is
+ begin
+ Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
+ end Write_Lock;
+
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
---------------
procedure Read_Lock
- (L : not null access Lock;
+ (L : not null access RW_Lock;
Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end if;
end Unlock;
+ procedure Unlock (L : not null access RW_Lock) is
+ begin
+ Unlock (Lock (L.all)'Unrestricted_Access);
+ end Unlock;
+
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
end Initialize_Lock;
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock)
+ is
+ begin
+ Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
+ end Initialize_Lock;
+
+ procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
pragma Assert (Result = 0);
end Finalize_Lock;
+ procedure Finalize_Lock (L : not null access RW_Lock) is
+ begin
+ Finalize_Lock (Lock (L.all)'Unrestricted_Access);
+ end Finalize_Lock;
+
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
end Write_Lock;
procedure Write_Lock
+ (L : not null access RW_Lock;
+ Ceiling_Violation : out Boolean)
+ is
+ begin
+ Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
+ end Write_Lock;
+
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
---------------
procedure Read_Lock
- (L : not null access Lock;
+ (L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
pragma Assert (Result = 0);
end Unlock;
+ procedure Unlock (L : not null access RW_Lock) is
+ begin
+ Unlock (Lock (L.all)'Unrestricted_Access);
+ end Unlock;
+
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
end Initialize_Lock;
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock) is
+ begin
+ Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
+ end Initialize_Lock;
+
+ procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
pragma Assert (Result = 0);
end Finalize_Lock;
+ procedure Finalize_Lock (L : not null access RW_Lock) is
+ begin
+ Finalize_Lock (Lock (L.all)'Unrestricted_Access);
+ end Finalize_Lock;
+
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
end Write_Lock;
procedure Write_Lock
+ (L : not null access RW_Lock;
+ Ceiling_Violation : out Boolean)
+ is
+ begin
+ Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
+ end Write_Lock;
+
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
---------------
procedure Read_Lock
- (L : not null access Lock;
+ (L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
pragma Assert (Result = 0);
end Unlock;
+ procedure Unlock (L : not null access RW_Lock) is
+ begin
+ Unlock (Lock (L.all)'Unrestricted_Access);
+ end Unlock;
+
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
end Initialize_Lock;
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock)
+ is
+ begin
+ Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
+ end Initialize_Lock;
+
+ procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
pragma Assert (Result = 0);
end Finalize_Lock;
+ procedure Finalize_Lock (L : not null access RW_Lock) is
+ begin
+ Finalize_Lock (Lock (L.all)'Unrestricted_Access);
+ end Finalize_Lock;
+
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : int;
begin
end Write_Lock;
procedure Write_Lock
+ (L : not null access RW_Lock;
+ Ceiling_Violation : out Boolean)
+ is
+ begin
+ Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
+ end Write_Lock;
+
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
---------------
procedure Read_Lock
- (L : not null access Lock;
+ (L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
pragma Assert (Result = 0);
end Unlock;
+ procedure Unlock (L : not null access RW_Lock) is
+ begin
+ Unlock (Lock (L.all)'Unrestricted_Access);
+ end Unlock;
+
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
(Prio : System.Any_Priority;
L : not null access Lock);
procedure Initialize_Lock
+ (Prio : System.Any_Priority;
+ L : not null access RW_Lock);
+ procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level);
pragma Inline (Initialize_Lock);
-- These operations raise Storage_Error if a lack of storage is detected
procedure Finalize_Lock (L : not null access Lock);
+ procedure Finalize_Lock (L : not null access RW_Lock);
procedure Finalize_Lock (L : not null access RTS_Lock);
pragma Inline (Finalize_Lock);
-- Finalize a lock object, freeing any resources allocated by the
(L : not null access Lock;
Ceiling_Violation : out Boolean);
procedure Write_Lock
+ (L : not null access RW_Lock;
+ Ceiling_Violation : out Boolean);
+ procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False);
procedure Write_Lock
-- per-task lock is implicit in Exit_Task.
procedure Read_Lock
- (L : not null access Lock;
+ (L : not null access RW_Lock;
Ceiling_Violation : out Boolean);
pragma Inline (Read_Lock);
-- Lock a lock object for read access. After this operation returns,
procedure Unlock
(L : not null access Lock);
procedure Unlock
+ (L : not null access RW_Lock);
+ procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False);
procedure Unlock
-- --
-- S p e c --
-- --
--- Copyright (C) 1991-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1991-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- --
type Lock is new Integer;
+ type RW_Lock is new Integer;
+
type RTS_Lock is new Integer;
type Suspension_Object is new Integer;
-- --
-- S p e c --
-- --
--- Copyright (C) 1991-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1991-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- --
pragma Preelaborate;
type Lock is limited private;
+ type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
Owner_Priority : Integer;
end record;
+ type RW_Lock is new Lock;
+
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record
-- --
-- S p e c --
-- --
--- Copyright (C) 1991-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1991-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- --
pragma Preelaborate;
type Lock is limited private;
+ type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
Owner_Priority : Integer;
end record;
+ type RW_Lock is new Lock;
+
type Condition_Variable is new System.Win32.HANDLE;
type RTS_Lock is new System.OS_Interface.CRITICAL_SECTION;
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2010, AdaCore --
+-- Copyright (C) 1995-2011, AdaCore --
-- --
-- GNAT 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- --
pragma Preelaborate;
type Lock is limited private;
+ type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
private
type Lock is new System.OS_Interface.pthread_mutex_t;
+ type RW_Lock is new Lock;
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record
pragma Preelaborate;
type Lock is limited private;
+ type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
private
type Lock is new System.OS_Interface.pthread_mutex_t;
+ type RW_Lock is new System.OS_Interface.pthread_rwlock_t;
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record
-- --
-- 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- --
type Lock is limited private;
type Lock_Ptr is access all Lock;
+ type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
Frozen : Boolean := False;
end record;
+ type RW_Lock is new Lock;
+
type RTS_Lock is new Lock;
type Suspension_Object is record
-- --
-- S p e c --
-- --
--- Copyright (C) 1991-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1991-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- --
pragma Preelaborate;
type Lock is limited private;
+ type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
Ceiling : Interfaces.C.int;
end record;
+ type RW_Lock is new Lock;
+
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record
pragma Preelaborate;
type Lock is limited private;
+ type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
Prio_Save : Interfaces.C.int;
end record;
+ type RW_Lock is new Lock;
+
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-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- --
pragma Preelaborate;
type Lock is limited private;
+ type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
-- Priority ceiling of lock
end record;
+ type RW_Lock is new Lock;
+
type RTS_Lock is new Lock;
type Suspension_Object is record
return;
end if;
- STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
+ if Locking_Policy = 'R' then
+ STPO.Write_Lock (Object.RWL'Unrestricted_Access, Ceiling_Violation);
+ else
+ STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
+ end if;
if Single_Lock then
Lock_RTS;
Unlock_RTS;
end if;
- STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
+ if Locking_Policy = 'R' then
+ STPO.Write_Lock
+ (Object.RWL'Unrestricted_Access, Ceiling_Violation);
+ else
+ STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
+ end if;
if Ceiling_Violation then
raise Program_Error with "Ceiling Violation";
Unlock_RTS;
end if;
- STPO.Unlock (Object.L'Unrestricted_Access);
-
- STPO.Finalize_Lock (Object.L'Unrestricted_Access);
+ if Locking_Policy = 'R' then
+ STPO.Unlock (Object.RWL'Unrestricted_Access);
+ STPO.Finalize_Lock (Object.RWL'Unrestricted_Access);
+ else
+ STPO.Unlock (Object.L'Unrestricted_Access);
+ STPO.Finalize_Lock (Object.L'Unrestricted_Access);
+ end if;
end Finalize;
----------------------
-- pragma Assert (Self_Id.Deferral_Level = 0);
Initialization.Defer_Abort_Nestable (Self_ID);
- Initialize_Lock (Init_Priority, Object.L'Access);
+
+ if Locking_Policy = 'R' then
+ Initialize_Lock (Init_Priority, Object.RWL'Access);
+ else
+ Initialize_Lock (Init_Priority, Object.L'Access);
+ end if;
+
Initialization.Undefer_Abort_Nestable (Self_ID);
Object.Ceiling := System.Any_Priority (Init_Priority);
(STPO.Self.Deferral_Level > 0
or else not Restrictions.Abort_Allowed);
- Write_Lock (Object.L'Access, Ceiling_Violation);
+ if Locking_Policy = 'R' then
+ Write_Lock (Object.RWL'Access, Ceiling_Violation);
+ else
+ Write_Lock (Object.L'Access, Ceiling_Violation);
+ end if;
-- We are entering in a protected action, so that we increase the
-- protected object nesting level (if pragma Detect_Blocking is
raise Program_Error;
end if;
- Read_Lock (Object.L'Access, Ceiling_Violation);
+ if Locking_Policy = 'R' then
+ Read_Lock (Object.RWL'Access, Ceiling_Violation);
+ else
+ Write_Lock (Object.L'Access, Ceiling_Violation);
+ end if;
if Ceiling_Violation then
raise Program_Error with "Ceiling Violation";
Object.Ceiling := Object.New_Ceiling;
end if;
- Unlock (Object.L'Access);
+ if Locking_Policy = 'R' then
+ Unlock (Object.RWL'Access);
+ else
+ Unlock (Object.L'Access);
+ end if;
end Unlock_Entries;
end System.Tasking.Protected_Objects.Entries;
type Protection_Entries (Num_Entries : Protected_Entry_Index) is new
Ada.Finalization.Limited_Controlled
with record
- L : aliased Task_Primitives.Lock;
+ L : aliased Task_Primitives.Lock;
+ RWL : aliased Task_Primitives.RW_Lock;
-- The underlying lock associated with a Protection_Entries.
-- Note that you should never (un)lock Object.L directly, but instead
-- use Lock_Entries/Unlock_Entries.
projects / platform / upstream / gcc.git / commitdiff