测试delphi支持的线程锁的效率

公告

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.

原文地址：https://blog.csdn.net/qq_25439957/article/details/89431389

posted on 2021-05-17 13:19 红鱼儿阅读(959) 评论(0) 编辑收藏举报

会员力量，点亮园子希望

刷新页面返回顶部