TMutexAcquire (Delphi)

From RAD Studio Code Examples
Jump to: navigation, search

Description

This example demonstrates the use and the need for managing processing of threads competing for the same resource. This example manages three sorting routines in three separate threads using the following mechanisms:

1. The TThread Synchronize method executes the procedure it is handed in the main thread. This is required for executing VCL from a thread. It also can be used to avoid contension over shared resources (in this case, WaitForPaint).

2. TThread Queue can be used to queue access to a shared resource. Queue cannot be used to execute VCL tasks.

3. A mutex can be used to hold the access of a resource.

This example allows you to turn off the use of Synchronise, Queue and the mutex. Use any one of these to avoid conflicts. Turning them all off results in conflicts.

Code

uses
  Classes, Graphics, ExtCtrls, Dialogs, SysUtils, SyncObjs;

type

{ TSortThread }

  PThreadSortArray = ^TThreadSortArray;
  TThreadSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;

  TSortThread = class(TThread)
  private
    FBox: TPaintBox;
    FSortArray: PThreadSortArray;
    FSize: Integer;
    procedure DoVisualSwap(A, B, I, J: Integer);
  protected
    procedure Execute; override;
    procedure VisualSwap(A, B, I, J: Integer);
    procedure Sort(var A: array of Integer); virtual; abstract;
    procedure WaitBeforePaint;
  public
    constructor Create(Box: TPaintBox; var SortArray: array of Integer);
  end;

{ TBubbleSort }

  TBubbleSort = class(TSortThread)
  protected
    procedure Sort(var A: array of Integer); override;
  end;

{ TSelectionSort }

  TSelectionSort = class(TSortThread)
  protected
    procedure Sort(var A: array of Integer); override;
  end;

{ TQuickSort }

  TQuickSort = class(TSortThread)
  protected
    procedure Sort(var A: array of Integer); override;
  end;

procedure PaintLine(Canvas: TCanvas; I, Len: Integer);

var
  UseSynchronize, UseQueue, useMutex: Boolean;
  mysleep: Integer;
  myMutex: TMutex;

implementation

{
Notice that it is handy to have WaitBeforePaint be a member of the thread base class TSortThread.  This allows Synchronize calls to ConflictMsg from inside of WaitBeforePaint, something that would not be possible for a proc outside of the thread classes.  This means that there are three instances of WaitBeforePaint running, but we still get the contention we are looking for over the global counter mysleep.
}
procedure TSortThread.WaitBeforePaint;
var
  supersleep: integer;
begin
  if (mysleep <> 0) then
  begin
    Synchronize(
    procedure
    begin
      MessageDlg(Format('Conflict! mysleep = %d.', [mysleep]), mtError, [mbOk], 0);
    end);
    Terminate;
    exit;
  end;

  mysleep:= 500000;
  while (mysleep > 0) do // use a process intensive loop here.  We are trying to block.
  begin
    supersleep := mysleep*mysleep;
    mysleep := mysleep - 1;
  end;
end;

procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
begin
  Canvas.PolyLine([Point(0, I * 2 + 1), Point(Len, I * 2 + 1)]);
end;

{ TSortThread }

constructor TSortThread.Create(Box: TPaintBox; var SortArray: array of Integer);
begin
  FBox := Box;
  FSortArray := @SortArray;
  FSize := High(SortArray) - Low(SortArray) + 1;
  FreeOnTerminate := True;
  inherited Create(False);
end;

{ Since DoVisualSwap uses a VCL component (i.e., the TPaintBox), it should never be called directly by this thread. DoVisualSwap should be called by passing it to the Synchronize method, which causes DoVisualSwap to be executed by the main VCL thread, avoiding multi-thread conflicts. See VisualSwap for an example of calling Synchronize. }

procedure TSortThread.DoVisualSwap(A, B, I, J: Integer);
begin
  with FBox do
  begin
    Canvas.Pen.Color := clBtnFace;
    PaintLine(Canvas, I, A);
    PaintLine(Canvas, J, B);
    Canvas.Pen.Color := clRed;
    PaintLine(Canvas, I, B);
    PaintLine(Canvas, J, A);
  end;
end;

{ VisusalSwap is a wrapper on DoVisualSwap, used to decide how to call the shared non-VCL resource inside of Synchronize, Queue or the mutex.

Notice the use of inline procedures in the Synchronize calls.  This demonstrates how to pass parameters through Synchronize or Queue. }

procedure TSortThread.VisualSwap(A, B, I, J: Integer);
var conflict: Integer;
begin

  // shared resource that is not VCL
  if (useMutex) then myMutex.Acquire;
  if (UseSynchronize) then Synchronize(
    procedure
    begin
      WaitBeforePaint;
    end)
    else if (UseQueue) then Queue(
      procedure
      begin
        WaitBeforePaint;
      end)
      else WaitBeforePaint;
  if (useMutex) then myMutex.Release;

  Synchronize(
    procedure
    begin
    DoVisualSwap(A, B, I, J);
    end);
end;

{ The Execute method is called when the thread starts. }

procedure TSortThread.Execute;
begin
  Sort(Slice(FSortArray^, FSize));
end;

{ TBubbleSort }

procedure TBubbleSort.Sort(var A: array of Integer);
var
  I, J, T: Integer;
begin
  for I := High(A) downto Low(A) do
    for J := Low(A) to High(A) - 1 do
      if A[J] > A[J + 1] then
      begin
        VisualSwap(A[J], A[J + 1], J, J + 1);
        T := A[J];
        A[J] := A[J + 1];
        A[J + 1] := T;
        if Terminated then Exit;
      end;
end;

{ TSelectionSort }

procedure TSelectionSort.Sort(var A: array of Integer);
var
  I, J, T: Integer;
begin
  for I := Low(A) to High(A) - 1 do
    for J := High(A) downto I + 1 do
      if A[I] > A[J] then
      begin
        VisualSwap(A[I], A[J], I, J);
        T := A[I];
        A[I] := A[J];
        A[J] := T;
        if Terminated then Exit;
      end;
end;

{ TQuickSort }

procedure TQuickSort.Sort(var A: array of Integer);

  procedure QuickSort(var A: array of Integer; iLo, iHi: Integer);
  var
    Lo, Hi, Mid, T: Integer;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo] < Mid do Inc(Lo);
      while A[Hi] > Mid do Dec(Hi);
      if Lo <= Hi then
      begin
        VisualSwap(A[Lo], A[Hi], Lo, Hi);
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
    if Terminated then Exit;
  end;

begin
  QuickSort(A, Low(A), High(A));
end;

Uses

Retrieved from "https://docwiki.embarcadero.com/CodeExamples/Alexandria/e/index.php?title=TMutexAcquire_(Delphi)&oldid=23708"