Txrwexclusive: une alternative au tmultireadexclusivewritesynchronizer standard de delphi.

Commenter

Contenu du snippet

Suite à une question sur un tutorial:
http://www.delphifr.com/tutorial.aspx?ID=231

voici une version plus rapide et plus légère que la classe Delphi de base (qui risque de ralentir tout le système dans certaines conditions d'utilisation, selon un article que j'ai lu une fois). Ceci dit, si je me souviens bien, le cas en question concernait un serveur qui devait gérer une centaine de threads en même temps (donc vraisemblablement pas l'usage "standard" qui est fait de cette classe).

Il y a toutefois une petite limitation: il n'est pas possible d'imbriquer un appel à LockRead avec LockWrite. Par exemple:
LockRead
LockWrite <- exception "Cannot write-lock an already read-locked object"
UnlockRead
UnlockWrite
n'est pas possible (et par sécurité déclenchera une exception).
De toute façon, quelle que soit la classe utilisée, le problème est intrinsèque au fonctionnement des objets critiques. Même avec la classe Delphi, utiliser des appels imbriqués ainsi ne garantit pas que d'autres threads ne vont pas modifier les données juste avant que le verrouillage par la méthode LockWrite soit effectuée (même à l'intérieur d'un bloc LockRead). Donc, ça n'a guère d'intérêt dans tous les cas de ne pas déclencher d'exceptions. En fait, la classe Delphi exécute des appels fictifs à UnlockRead avant LockWrite de façon à ramener à zéro le nombre de verrouillages en lecture (s'il y en a) avant d'entrer dans la zone de verrouillage en écriture. Ceci afin d'éviter des situations de blocage (dead-locking) qui pourraient survenir.

En effet, si on a au moins 2 threads qui effectuent la séquence de code ci-dessus, à moins que l'implémentation ait un moyen de savoir ce que le code va faire après (et ceci fait partie des problèmes dont l'informatique théorique a démontré l'impossibilité), il y aura forcément un des threads qui devra accepter qu'un des autres puisse entrer en mode écriture avant que lui-même puisse le faire si jamais cet autre thread est rentré en mode lecture en même temps que lui (ce qui est tout à fait possible). Ou alors, chacun des 2 threads devrait attendre que l'autre ait fini de lire, ce qui n'arrive jamais puisque pour finir de lire ils doivent d'abord écrire, situation classique de blocage...

Par contre, il est tout à fait possible de faire:
LockWrite
<-protection écriture exclusive
LockRead
UnlockWrite
<-protection lecture, les autres threads peuvent aussi lire à ce moment là
UnlockRead
La seule règle étant qu'un appel à LockWrite ne peut pas suivre un appel à LockRead non terminé par UnlockRead.

La différence avec l'implémentation de Borland, c'est que la mienne n'utilise pas un "event" pour la lecture, seulement des sections critiques. Donc, il peut y avoir autant de threads en lecture que l'on veut, ça ne ralentira pas le système car ils sont bloqués par une section critique (qui est beaucoup plus efficace). Donc, au moment de la libération du verrouillage en écriture, il n'y a pas 200 threads qui vont tester en même temps s'ils ont le droit ou non de passer.

Comme d'habitude, tout commentaire constructif est le bienvenu...

Merci de ne pas tenir compte de mes premiers commentaires (qui devraient bientôt être supprimés), j'ai parlé trop vite :(

Source / Exemple : 


unit XTLS;

interface

uses
  Windows,Classes,SyncObjs,SysUtils;

type
  (*
    TXTLS: Classe de base pour gérer le "thread local storage", tout simplement
           l'équivalent d'une threadvar. L'avantage c'est que ça fonctionnera
           aussi depuis une DLL.


      
  • )


  TXTLS=class
  private
    FIndex:Cardinal;
    function GetValue: Pointer;
    procedure SetValue(const Value: Pointer);
  protected
    property Value:Pointer read GetValue write SetValue;
  public
    constructor Create;
    destructor Destroy;override;
  end;

  (*
    TXRWExclusive: Classe de remplacement de TMultiReadExclusiveWriteSynchronizer
                   de Delphi (déclaré dans SysUtils.pas).


      
  • )


  TXRWExclusive=class(TXTLS)
  private
    FTotalReadLockCount:Integer;
    FUnLockEvent:TEvent;
    FWriteLockCount:Integer;
    FSection:TCriticalSection;
  protected
    procedure LockRead;virtual;
    procedure LockWrite;virtual;
    procedure UnLockRead;virtual;
    procedure UnLockWrite;virtual;
  public
    constructor Create;

    property WriteLockCount:Integer read FWriteLockCount;

    destructor Destroy;override;
  end;

implementation

{ TXTLS }

constructor TXTLS.Create;
begin
  inherited;
  FIndex:=TlsAlloc;
  if FIndex=TLS_OUT_OF_INDEXES then
    RaiseLastOSError;
end;

destructor TXTLS.Destroy;
begin
  if not TlsFree(FIndex) then
    RaiseLastOSError;
  inherited;
end;

function TXTLS.GetValue: Pointer;
var
  e:Cardinal;
begin
  Result := TlsGetValue(FIndex);
  e:=GetLastError;
  if e<>ERROR_SUCCESS then
    raise Exception.Create(SysErrorMessage(GetLastError));
end;

procedure TXTLS.SetValue(const Value: Pointer);
begin
  if not TlsSetValue(FIndex,Value) then
    RaiseLastOSError;
end;

{ TXRWExclusive }

constructor TXRWExclusive.Create;
begin
  inherited;
  FUnLockEvent:=TEvent.Create(nil,True,True,'');
  FSection:=TCriticalSection.Create;
end;

destructor TXRWExclusive.Destroy;
begin
  if FTotalReadLockCount>0 then
    raise Exception.Create('Object still locked while destroying instance');
  FSection.Destroy;
  FUnLockEvent.Destroy;
  inherited;
end;

procedure TXRWExclusive.LockRead;
begin
  FSection.Enter;
  try
    FUnLockEvent.ResetEvent;
    Value:=Pointer(Integer(Value)+1);
    InterlockedIncrement(FTotalReadLockCount);
  finally
    FSection.Leave;
  end;
end;

procedure TXRWExclusive.LockWrite;
begin
  if Value<>nil then
    raise Exception.Create('Cannot write-lock an already read-locked object');
  FSection.Enter;
  repeat
    if FTotalReadLockCount=Integer(Value) then
      Break;
    FUnLockEvent.WaitFor(INFINITE);
  until False;
  FEvent.ResetEvent;
  Inc(FWriteLockCount);
end;

procedure TXRWExclusive.UnLockRead;
begin
  Value:=Pointer(Integer(Value)-1);
  if Integer(Value)<0 then
    raise Exception.Create('Negative thread local read unlock count.');
  if InterlockedDecrement(FTotalReadLockCount)<0 then
    raise Exception.Create('Negative global read unlock count.');
  if Value=nil then
    FUnLockEvent.SetEvent;
end;

procedure TXRWExclusive.UnLockWrite;
begin
  Dec(FWriteLockCount);
  FSection.Leave;
end;

end.

Conclusion :


Merci de lire mon commentaire sur le tutorial mentionné ci-dessus avant de me demander à quoi cette classe sert...
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Forman)