delphi xe 并行 多线程 队列 TCriticalSection TMutex TSpinlock TMonitor

直接上图：运行结果如下：

如

代码如下
：

unit Unit5;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs
  ,System.Diagnostics, FMX.ScrollBox, FMX.Memo, FMX.Controls.Presentation,
  FMX.StdCtrls
  ,System.SyncObjs
  ,System.Threading;

type
  TForm5 = class(TForm)
    Multithreaded: TButton;
    btnSingleThreaded: TButton;
    MTwithlocking: TButton;
    MTwithmutex: TButton;
    MTwithTMonitor: TButton;
    MTwithspinlock: TButton;
    MTwithinterlocked: TButton;
    Memo1: TMemo;
    procedure btnSingleThreadedClick(Sender: TObject);
    procedure MultithreadedClick(Sender: TObject);
    procedure MTwithlockingClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MTwithmutexClick(Sender: TObject);
    procedure MTwithTMonitorClick(Sender: TObject);
    procedure MTwithspinlockClick(Sender: TObject);
    procedure MTwithinterlockedClick(Sender: TObject);
  private
    { Private declarations }
      FTimer: TStopwatch;
      FValue:integer;
      FLock: TCriticalSection;
      FMutex: TMutex;
      FSpinlock: TSpinlock;
      procedure StartTimer;
      procedure StopTimer;
      procedure LogValue(const msg:string) ;
      procedure IncValue;
      procedure DecValue;
      procedure RunInParallel(task1, task2: TProc);
      procedure LockedIncValue;
      procedure LockedDecValue;
      procedure MutexIncValue;
      procedure MutexDecValue;
      procedure MonitorLockedIncValue;
      procedure MonitorLockedDecValue;
      procedure SpinlockIncValue;
      procedure SpinlockDecValue ;
      procedure InterlockedIncValue;
      procedure InterlockedDecValue;
  public
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation

{$R *.fmx}
   uses System.DateUtils;//调用单元文件  必须D      MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
const
  CNumRepeat = 10000000;

procedure TForm5.btnSingleThreadedClick(Sender: TObject);
begin
{按顺序先后执行，先执行完加法运算后，再执行减法去运算；结果应当为0；
如果是同时运行又会有啥结果呢？请看---->多线程Multithreaded按钮}
  StartTimer;
  FValue := 0;
  IncValue;
  DecValue;
  StopTimer;
  LogValue('Single threaded');
end;

procedure TForm5.StartTimer;
begin
  FTimer := TStopwatch.StartNew;
end;

procedure TForm5.StopTimer;
begin
  FTimer.Stop;
end;

procedure TForm5.LogValue(const msg:string) ;
begin
   memo1.Lines.add(format('%S  %D [%d 毫秒]',[msg ,FValue,FTimer.ElapsedMilliseconds]));
end;
procedure TForm5.IncValue;
var
i,value:integer;
begin
    for i := 1 to CNumRepeat do begin
    value := FValue;
    FValue := value + 1;
  end;
end;

procedure TForm5.DecValue;
var
i,value:integer;
begin
    for i := 1 to CNumRepeat do
    begin
    value := FValue;
    FValue :=  FValue - 1;
    end;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
   MEMO1.Lines.Add('正确的答案应当是 0');
end;

procedure TForm5.RunInParallel(task1, task2: TProc);
var
tast: array[0..1] of iTask; //System.Threading

begin
   tast[0]:=TTASK.Run(task1) ;
   tast[1]:=TTASK.Run(task2) ;
   TTASK.WaitForAll(TAST);
end;

procedure TForm5.MultithreadedClick(Sender: TObject);
begin
  StartTimer;
  FValue := 0;
  RunInParallel(IncValue, DecValue);
  StopTimer;
  LogValue('Multithreaded');
    {执行结果如果是0，你可能也快中福利彩票特等奖了。
    在任何给定的时间，有数百个线程在不同的程序中运行，并且它们都在争夺有限数量的CPU核心。
    名为同步并发，实则在同时在运行时，还要让位给其它程序一定的时间，否则多任务的系统就
    变成单任务的系统，返回到WINDOWS 3.0时代了。正如司机带着老婆和老妈去游玩，2档上路；
    老婆和老妈同时要换档：老婆要挂3档，老妈挂到1档。最终是挂到多少档？
档位就是共享的资源，多线程共享资源时，‘答案’是不确定的。
       ～
     (~.~)
       ~
    一定要同步，答案要确定，那又如何解决呢？请看往下看
    }
end;

procedure TForm5.MTwithlockingClick(Sender: TObject);
begin
  StartTimer;
  FValue := 0;
  FLock := TCriticalSection.Create; // ,System.SyncObjs
  {临界区对象TCriticalSection,向系统申请对下面代码的特权}
  try
   RunInParallel(LockedIncValue, LockedDecValue);
  finally
    FreeAndNil(FLock);  {用特权处理资源完毕，就得释放特权，退还特权给系统！
     防止蹲着茅坑不拉SHI }
  end;
  StopTimer;
  LogValue('Critical section');

end;

procedure TForm5.LockedIncValue;
var
i,value:integer;
begin
    for i := 1 to CNumRepeat do
    begin
    FLock.Acquire;//占着厕所；
    value := FValue;
    FValue :=  FValue + 1;
    Flock.Release;////离开厕所，让给下一位；
    end;

end;

procedure TForm5.LockedDecValue;
var
i,value:integer;
begin
    for i := 1 to CNumRepeat do
    begin
    FLock.Acquire;//占着厕所；
    value := FValue;
    FValue :=  FValue - 1;
    Flock.Release;////离开厕所，让给下一位；
    end;

end;

procedure TForm5.MTwithmutexClick(Sender: TObject);
begin
//互斥锁 ，效率超级低，存在界面无响应问题 ，请继续往下看
   StartTimer;
   FValue := 0;
  FMutex := TMutex.Create(nil, false, '');
  try
   RunInParallel(MutexIncValue, MutexDecValue);
   finally
    //FreeAndNil(FLock); //原来
   FreeAndNil(FMutex)
  end;

  StopTimer;
  LogValue('Mutex');
end;

procedure TForm5.MutexIncValue;
var
  i: integer;
  value: integer;
begin
  for i := 1 to CNumRepeat do begin
    FMutex.Acquire;
    value := FValue;
    FValue := value + 1;
    FMutex.Release;
  end;
end;

procedure TForm5.MutexDecValue;
var
  i: integer;
  value: integer;
begin
  for i := 1 to CNumRepeat do begin
    FMutex.Acquire;
    value := FValue;
    FValue := value - 1;
    FMutex.Release;
  end;
end;

procedure TForm5.MTwithTMonitorClick(Sender: TObject);
begin
{它比TCriticalSection更快更简单（您不必创建单独的对象）。只有在真正使用共享对象时才应该使用TMonitor，
这样就可以直接锁定它。它不使用临界区，而是一种名为spinlock的改进思想。}
  StartTimer;
  FValue := 0;
  RunInParallel(MonitorLockedIncValue, MonitorLockedDecValue);
  StopTimer;
  LogValue('TMonitor');
end;

procedure TForm5.MonitorLockedIncValue;
var
  value: integer;
  i: Integer;
begin
  for i := 1 to CNumRepeat do begin
    System.TMonitor.Enter(Self);
    value := FValue;
    FValue := value + 1;
    System.TMonitor.Exit(Self);
  end;
end;

procedure Tform5.MonitorLockedDecValue;
var
value,i:integer;
begin
    for i := 1 to CNumRepeat do
    begin
      try
        system.TMonitor.Enter(SELF);
        VALUE:=fvalue;
        fvalue:=value-1;
        system.TMonitor.Exit(self);
      finally

      end;
    end;

end;

procedure TForm5.MTwithspinlockClick(Sender: TObject);
begin

{自旋锁假定用它保护的代码非常短，并且自旋锁将被快速释放。如果已经从另一个线程获取了自旋锁，则代码首先尝试主动等待或旋转。代码不是进入睡眠状态，而是在紧密循环中运行，并不断检查自旋锁是否可用。只有在一段时间后才发生这种情况，线程才会进入休眠状态}

{TSpinLock是一个记录，而不是一个对象，所以没有必要释放它。 您仍然需要创建它，因为一些数据在构造函数中初始化.

TSpinLock唯一的问题是它不是可重入的。 如果已经获得自旋锁的线程第二次调用Enter，则代码将引发异常（如果已将True传递给构造函数）或阻塞。 但是，该实现提供了IsLocked和IsLockedByCurrentThread函数，您可以使用TSpinLock作为基函数来编写可重入的自旋锁。}
  StartTimer;
  FValue := 0;
  FSpinlock := TSpinLock.Create(false);
  RunInParallel(SpinlockIncValue, SpinlockDecValue);
  StopTimer;
  LogValue('Spinlock');
end;

procedure TForm5.SpinlockIncValue;
var
  i: integer;
  value: integer;
begin
  for i := 1 to CNumRepeat do
      begin
        FSpinlock.Enter;
        value := FValue;
        FValue := value + 1;
        FSpinlock.Exit;
      end;
end;

procedure TForm5.SpinlockDecValue;
var
i:integer;
value:integer;
 begin
    for I := 1 to CNumRepeat do
    begin
       Fspinlock.Enter;
       VALUE:=FVALUE;
       FVALUE:=VALUE-1;
       Fspinlock.Exit;
    end;

 end;

procedure TForm5.MTwithinterlockedClick(Sender: TObject);//互锁操作,汇编指令级别
begin

{当共享数据足够小并且您只需要递增它或交换两个值时，可以选择在不锁定的情况下执行此操作。所有现代处理器都实现了可以对存储器位置进行简单操作的指令，使得另一个处理器不会中断正在进行的操作。
这些指令有时被称为互锁操作，而用它们编程的整个想法被称为无锁编程，或者有时称为微锁定。后一个术语实际上更合适，因为CPU确实做了一些锁定。这种锁定发生在汇编指令级别，因此比基于操作系统的锁定（如关键部分）快得多。
}
  StartTimer;
  FValue := 0;
  RunInParallel(InterlockedIncValue, InterlockedDecValue);
  StopTimer;
  LogValue('Interlocked');
end;
procedure TForm5.InterlockedIncValue;
var
  i: integer;
begin
  for i := 1 to CNumRepeat do
    TInterlocked.Increment(FValue);
end;

procedure TForm5.InterlockedDecValue;
var
  i: integer;
begin
  for i := 1 to CNumRepeat do
    TInterlocked.Decrement(FValue);

end;

end.