CriticalSections wie verwenden?

[Sir Rufo]

Um das mit den CriticalSections mal etwas besser zu verdeutlichen habe ich mal mein WorkThread-Beispiel etwas umgeändert um folgende Situationen darzustellen:
- optimales Laufzeitverhalten mit einem Minimum an Störungen des Threads durch Zugriffe von außen (bzw. durch den Event, der ja in einem anderen Thread-Kontext läuft und somit auch einen Zugriff von außen darstellt)
- blockierndes Laufzeitverhalten durch ein ungeschicktes Verwenden von CS
- Deadlock durch CS

Mit den beiden Compilerschaltern kann der Thread entsprechend eingestellt werden.

Delphi-Quellcode:

unit uWorkThread;

{.$DEFINE DEADLOCK}
{.$DEFINE BLOCKING}

interface

uses
  Generics.Collections,
  Classes,
  SyncObjs;

type
  TWorkItem = record
    TimeStamp : TDateTime;
  end;

  TWorkQueue = TQueue< TWorkItem >;

  TWorkNotify = procedure( WorkItem : TWorkItem ) of object;
  TWorkType = ( wtSync, wtQueue );

  TWorkThread = class( TThread )
  private
    { Private-Deklarationen }

    FCSWork : TCriticalSection;
    FCSQueue : TCriticalSection;
    FCSWorkType : TCriticalSection;

    FWorkQueue : TWorkQueue;
    FOnWork : TWorkNotify;
    FWorkType : TWorkType;

    procedure DoOnWork;
    procedure SetOnWork( const Value : TWorkNotify );
    function GetOnWork : TWorkNotify;
    procedure SetWorkType( const Value : TWorkType );
    function GetWorkType : TWorkType;

  protected
    procedure Execute; override;

  public
    property WorkType : TWorkType read GetWorkType write SetWorkType;
    property OnWork : TWorkNotify read GetOnWork write SetOnWork;
    constructor Create( CreateSuspended : Boolean );
    destructor Destroy; override;
  end;

implementation

uses
  SysUtils;

{ TProgressThread }

constructor TWorkThread.Create( CreateSuspended : Boolean );
  begin
    FCSWork := TCriticalSection.Create;
    FCSQueue := TCriticalSection.Create;
    FCSWorkType := TCriticalSection.Create;

    FCSWork.Enter;
    FCSQueue.Enter;
    FCSWorkType.Enter;
    try
      inherited;

      FWorkQueue := TWorkQueue.Create;
      FWorkType := wtSync;

    finally
      FCSWork.Leave;
      FCSQueue.Leave;
      FCSWorkType.Leave;
    end;
  end;

destructor TWorkThread.Destroy;
  begin
    FCSWork.Enter;
    FCSQueue.Enter;
    FCSWorkType.Enter;
    try

      FWorkQueue.Free;

      inherited;
    finally
      FCSWork.Leave;
      FCSQueue.Leave;
      FCSWorkType.Leave;
      FreeAndNil( FCSWork );
      FreeAndNil( FCSQueue );
      FreeAndNil( FCSWorkType );
    end;
  end;

procedure TWorkThread.DoOnWork;
  var
    WorkItem : TWorkItem;
  begin

    FCSWork.Enter;
    try
      WorkItem := FWorkQueue.Dequeue;
    finally
      FCSWork.Leave;
    end;

    {$IFDEF BLOCKING}

    FCSWork.Enter;

    {$ELSE}

    FCSQueue.Enter;

    {$ENDIF}

    try

      if Assigned( FOnWork ) then
        FOnWork( WorkItem );

    finally

      {$IFDEF BLOCKING}

      FCSWork.Leave;

      {$ELSE}

      FCSQueue.Leave;

      {$ENDIF}

    end;

  end;

procedure TWorkThread.Execute;
  var
    WorkItem : TWorkItem;
    Counter : Integer;
  begin
    { Thread-Code hier einfügen }
    Counter := 0;
    while not Terminated and ( Counter < 1000 ) do
      begin

        WorkItem.TimeStamp := Now;
        Inc( Counter );

        FCSWork.Enter;
        try
          FWorkQueue.Enqueue( WorkItem );
        finally
          FCSWork.Leave;
        end;

        {$IFDEF DEADLOCK}

        FCSWork.Enter;
        try

          {$ENDIF}

          case WorkType of
            wtSync :
              Synchronize( DoOnWork );
            wtQueue :
              Queue( DoOnWork );
          end;

          {$IFDEF DEADLOCK}

        finally
          FCSWork.Leave;
        end;

        {$ENDIF}

        //Sleep( 10 );
      end;
  end;

function TWorkThread.GetOnWork : TWorkNotify;
  begin

    {$IFDEF BLOCKING}

    FCSWork.Enter;

    {$ELSE}

    FCSQueue.Enter;

    {$ENDIF}

    try

      Result := FOnWork;

    finally

      {$IFDEF BLOCKING}

      FCSWork.Leave;

      {$ELSE}

      FCSQueue.Leave;

      {$ENDIF}

    end;
  end;

function TWorkThread.GetWorkType : TWorkType;
  begin
    FCSWorkType.Enter;
    try
      Result := FWorkType;
    finally
      FCSWorkType.Leave;
    end;
  end;

procedure TWorkThread.SetOnWork( const Value : TWorkNotify );
  begin

    {$IFDEF BLOCKING}

    FCSWork.Enter;

    {$ELSE}

    FCSQueue.Enter;

    {$ENDIF}

    try

      FOnWork := Value;

    finally

      {$IFDEF BLOCKING}

      FCSWork.Leave;

      {$ELSE}

      FCSQueue.Leave;

      {$ENDIF}

    end;
  end;

procedure TWorkThread.SetWorkType( const Value : TWorkType );
  begin
    FCSWorkType.Enter;
    try
      FWorkType := Value;
    finally
      FCSWorkType.Leave;
    end;
  end;

end.

Wenn man jetzt die Laufzeiten von optimal und blockierend betrachtet (deadlock läuft ja gar nicht) dann sieht man folgendes:
Erstellung: Zeitpunkt der Erstellung im Thread
Ausgabe: Zeitpunkt der Ausgabe in der ListBox
optimal

Code:

Erstellung     Ausgabe
============   ============
01:43:52.380 - 01:43:52.381
01:43:52.380 - 01:43:52.382
01:43:52.380 - 01:43:52.384
01:43:52.380 - 01:43:52.392
01:43:52.380 - 01:43:52.394
01:43:52.380 - 01:43:52.395
01:43:52.380 - 01:43:52.397
01:43:52.380 - 01:43:52.397
01:43:52.380 - 01:43:52.399
...
01:43:52.386 - 01:43:53.961

Der Thread hat nach 6/1000 Sekunden alle 1000 Einträge erzeugt.
Bis zu diesem Zeitpunkt wurden 3 Einträge in die ListBox eingetragen.
Erzeugung und Ausgabe laufen aber parallel, die Ausgabe dauert halt nur länger als die Erstellung

blockierend

Code:

Erstellung     Ausgabe
============   ============
01:42:10.625 - 01:42:10.626 <- Ausgabe erfolgt
01:42:10.625 - 01:42:10.626
...
01:42:10.626 - 01:42:10.671
01:42:10.626 - 01:42:10.673
01:42:10.626 - 01:42:10.675 <- Erstellung stoppt
01:42:10.673 - 01:42:10.677 <- Erstellung geht weiter
01:42:10.673 - 01:42:10.679
01:42:10.673 - 01:42:10.681
...

hier erfolgt nun entweder die Ausgabe oder die Erstellung, aber keine parallele Verarbeitung.

Source und Exe im Anhang