delphi XE4多线程critical section问题
Posted
tags:
篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了delphi XE4多线程critical section问题相关的知识,希望对你有一定的参考价值。
有栅格图像一幅(每个栅格代表一个像素,有9000行*6000列),现在要设置两个thread来对图像进行处理,以提高每一行每一行读取的效率,想让两个thread同时处理,结果各种阴差阳错吧,两个thread设置成了一个先进来对图像的一行进行处理,另一个等这个处理完了之后再处理下一行,总之这样交替进行。我知道这样会很慢,但是老板(也就是教授)觉得反正都这样了,就看看能有多慢。但是由于我不是计算机系出身也没学过delphi,这个多线程看的我云里雾里。之前代码如下:
这是thread里面处理图像的过程,我老板说critical section写的不对:
这是主函数里面设置的thread:
现在就是不晓得应该怎么改了,求大神指教哇!要代码,不要思路了,因为比较着急。还有就是因为我在国外,所以压缩文件里面希望能加上代码的截图,这样中文注释就不会在解压缩的过程中变乱码了
按你的意思,2个线程同时工作的话逻辑应该是:线程1做完了,线程1应该就要等待,然后线程2做,线程2做完了,就等待,线程1做。
在线程1做完了就关掉(就是线程1做完了,线程1等待),在Execute里面写FreeOnTerminate:=True,在Thread1Done里面启动线程2,线程2的Thread2Done里面启动线程1.循环。。。。临界区都不要。
逻辑才不会乱,你现在用一个Execute函数(当然是一个) 用一个ThreadDone 。。当然各种阴差阳错。
//leaveCriticalSection写到Thread1Done 和 Thread2Done 里面去。
TRTTIContext 多线程问题
【中文标题】TRTTIContext 多线程问题【英文标题】:TRTTIContext multi-thread issue 【发布时间】:2015-02-06 17:34:03 【问题描述】:我读过的所有内容都表明 TRTTIContext 是线程安全的。
但是,TRTTIContext.FindType 似乎在多线程时偶尔会失败(返回 nil)。在它周围使用 TCriticalSection 可以解决此问题。请注意,我使用的是 XE6,而 XE 中似乎不存在该问题。 编辑:似乎存在于所有具有新 RTTI 单元的 Delphi 版本中。
我设计了一个测试项目,您可以自己查看。创建一个新的 VCL 项目,删除一个 TMemo 和一个 TButton,将 unit1 替换为下面,并分配 Form1.OnCreate、Form1.OnDestroy 和 Button1.OnClick 事件。关键 CS 是 TTestThread.Execute 中的 GRTTIBlock。目前已禁用,当我使用 200 个线程运行时,我会遇到 3 到 5 次失败。启用 GRTTIBlock CS 可消除故障。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, SyncObjs, Contnrs, RTTI;
type
TTestThread = class(TThread)
private
FFailed: Boolean;
FRan: Boolean;
FId: Integer;
protected
procedure Execute; override;
public
property Failed: Boolean read FFailed;
property Ran: Boolean read FRan;
property Id: Integer read FId write FId;
end;
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FThreadBlock: TCriticalSection;
FMaxThreadCount: Integer;
FThreadCount: Integer;
FRanCount: Integer;
FFailureCount: Integer;
procedure Log(AStr: String);
procedure ThreadFinished(Sender: TObject);
procedure LaunchThreads;
end;
var
Form1: TForm1;
implementation
var
GRTTIBlock: TCriticalSection;
$R *.dfm
TTestThread
procedure TTestThread.Execute;
var
ctx : TRTTIContext;
begin
// GRTTIBlock.Acquire;
try
FFailed := not Assigned(ctx.FindType('Unit1.TForm1'));
FRan := True;
finally
// GRTTIBlock.Release;
end;
end;
TForm1
procedure TForm1.Button1Click(Sender: TObject);
begin
Randomize;
LaunchThreads;
Log(Format('Threads: %d, Ran: %d, Failures: %d',
[FMaxThreadCount, FRanCount, FFailureCount]));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FThreadBlock := TCriticalSection.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FThreadBlock.Free;
end;
procedure TForm1.Log(AStr: String);
begin
Memo1.Lines.Add(AStr);
end;
procedure TForm1.ThreadFinished(Sender: TObject);
var
tt : TTestThread;
begin
tt := TTestThread(Sender);
Log(Format('Thread %d finished', [tt.Id]));
FThreadBlock.Acquire;
try
Dec(FThreadCount);
if tt.Failed then
Inc(FFailureCount);
if tt.Ran then
Inc(FRanCount);
finally
FThreadBlock.Release;
end;
end;
procedure TForm1.LaunchThreads;
var
c : Integer;
ol : TObjectList;
t : TTestThread;
begin
FRanCount := 0;
FFailureCount := 0;
FMaxThreadCount := 200;
ol := TObjectList.Create(False);
try
// get all the thread objects created and ready
for c := 1 to FMaxThreadCount do
begin
t := TTestThread.Create(True);
t.FreeOnTerminate := True;
t.OnTerminate := ThreadFinished;
t.Id := c;
ol.Add(t);
end;
FThreadCount := FMaxThreadCount;
// start them all up
for c := 0 to ol.Count - 1 do
begin
TTestThread(ol[c]).Start;
Log(Format('Thread %d started', [TTestThread(ol[c]).Id]));
end;
repeat
Application.ProcessMessages;
FThreadBlock.Acquire;
try
if FThreadCount <= 0 then
Break;
finally
FThreadBlock.Release;
end;
until False;
finally
ol.Free;
end;
end;
initialization
GRTTIBlock := TCriticalSection.Create;
finalization
GRTTIBlock.Free;
end.
【问题讨论】:
我个人认为最好有一个全局上下文变量。似乎 FThreadBlock 没有任何作用。您将受益于此处的TList<T>
而不是TObjectList
。
ctx 是从池中创建的。它有一个引用计数机制,它的创建和销毁由 AtomicCmpExchange 调用保护。您在此测试中对系统施加了很大的压力。顺便说一句,FThreadBlock 总是在主线程中使用,并且不需要。
@Deltics,来自类单元:procedure TThread.DoTerminate;如果已分配(FOnTerminate)则开始,然后同步(CallOnTerminate);结束;
@Deltics:TThread.Terminate()
根本没有同步。它所做的只是直接为TThread.Terminated
属性赋值。 TThread.DoTerminate()
在工作线程的上下文中调用,而TThread.OnTerminate
在主线程的上下文中调用(除非您覆盖DoTerminate()
以直接调用OnTerminate
)。线程析构函数在线程上下文是否调用线程对象上的Free/Destroy()
时调用线程析构函数,FreeOnTerminate
为真时为工作线程本身,否则为不同的线程上下文。
这个问题在 Delphi 10 Seattle 中仍然存在
【参考方案1】:
我想我找到了问题所在。它在TRealPackage.FindType
和MakeTypeLookupTable
内。
MakeTypeLookupTable
检查是否分配了FNameToType
。如果不是,它运行DoMake
。这个受TMonitor保护,进入后会检查FNameToType
是否被再次分配。
到目前为止一切顺利。但是随后发生了错误,因为DoMake
内部的FNameToType
被分配导致其他线程愉快地通过MakeTypeLookupTable
并返回FindType
,然后在FNameToType.TryGetValue
中返回false 并返回nil。
修复:
由于FNameToType
在锁定的DoMake
之外使用作为可以继续执行的指示符,因此不应在DoMake
内分配,直到它被正确填满。
编辑: 举报为https://quality.embarcadero.com/browse/RSP-9815
最近(截至 2019 年 11 月)在 Delphi 10.3 Rio 中标记为已修复。
【讨论】:
您可以在回答中注明这会影响自 D2010 以来的所有 Delphi 版本,并且全局上下文变量也会失败。 @Stefan 我认为您的错误报告可以改进。我认为工程师不会理解它并且可能不会应用修复并不是难以置信的。我建议您添加一个包含故障再现的步骤部分。此处问题中提供的代码显示了如何做到这一点。更重要的是,我还鼓励您包含指向此问题的链接,以及来自TRealPackage.MakeTypeLookupTable
的摘录,以明确问题所在。您描述了这个问题,但包含代码提供了更多功能。最后,我有点害怕 ARM 上的双重检查锁定。
在 10.3 rio 中已修复。【参考方案2】:
正如 Stefan 所解释的,问题归结于双重检查锁定模式的错误实现。我想扩展他的答案,并尝试更清楚地说明问题所在。
错误代码如下所示:
procedure TRealPackage.MakeTypeLookupTable;
procedure DoMake;
begin
TMonitor.Enter(Flock);
try
if FNameToType <> nil then // presumes double-checked locking ok
Exit;
FNameToType := TDictionary<string,PTypeInfo>.Create;
// .... code removed from snippet that populates FNameToType
finally
TMonitor.Exit(Flock);
end;
end;
begin
if FNameToType <> nil then
Exit;
DoMake;
end;
错误在于填充共享资源FNameToType
的代码是在分配FNameToType
之后执行的。填充共享资源的代码需要在分配FNameToType
之前执行。
考虑两个线程,A 和 B。它们是第一个调用 MakeTypeLookupTable
的线程。线程A先到,发现FNameToType
是nil
,调用DoMake
。线程 A 获得锁并到达分配FNameToType
的代码。现在,在线程 A 设法运行更多代码之前,线程 B 到达 MakeTypeLookupTable
。它测试FNameToType
并发现它不是nil
,因此立即返回。然后调用代码使用FNameToType
。但是,FNameToType
尚未处于适合使用的状态。尚未填充,因为线程 A 尚未返回。
Embarcadero 方面最明显的解决方法如下:
procedure DoMake;
var
LNameToType: TDictionary<string,PTypeInfo>;
begin
TMonitor.Enter(Flock);
try
if FNameToType <> nil then // presumes double-checked locking ok
Exit;
LNameToType := TDictionary<string,PTypeInfo>.Create;
// .... populate LNameToType
FNameToType := LNameToType;
finally
TMonitor.Exit(Flock);
end;
end;
但是,请注意说 presumes double-checked locking ok 的注释。好吧,当机器有足够强大的内存模型时,双重检查锁定是可以的。所以在 x86 和 x64 上一切都很好。但 ARM 的内存模型相对较弱。所以我强烈怀疑这个修复在 ARM 上是否足够。事实上,我确实想知道 Embarcadero 在 RTL 中的其他什么地方使用了双重检查锁定。
如果TRealPackage
已在代码的接口部分声明,那么修补TRealPackage.MakeTypeLookupTable
以应用上述更改就很容易了。然而,事实并非如此。因此,为了解决问题,我建议如下:
-
为所有 RTTI 代码使用一个全局 RTTI 上下文。
在程序的初始化阶段,对该上下文进行调用,进而强制调用
TRealPackage.MakeTypeLookupTable
。因为初始化发生在单线程中,所以可以避免竞争条件。
像这样声明全局上下文,比如:
var
ctx: TRttiContext;
然后像这样强制调用TRealPackage.MakeTypeLookupTable
:
ctx.FindType('');
只要你所有的 RTTI 代码都通过这个单一的共享上下文,那么你就不会在这场竞赛中犯规。
【讨论】:
是的,解决了这个问题!现在要提交一些补丁;) RTL 中本地声明的上下文变量怎么样?似乎它会影响 Rest/Soap/JSON。 @LURD 当然。对于您无法控制的 RTTI 上下文,您无能为力。设计师真的搞砸了。他们应该强制执行上下文的单个共享全局实例。为什么他们认为我们都需要我们自己的实例,这些实例在编译时已修复,这超出了我的理解。 只有一个我们真正需要的 TRttiPool 的共享全局实例。所以只要你足够早让它加载你就可以了。以上是关于delphi XE4多线程critical section问题的主要内容,如果未能解决你的问题,请参考以下文章
Delphi XE4 E2010 不兼容的类型:“Cardinal”和“Pointer”
Delphi XE4或XE5:如何以弹出格式打开Goog le Chrome?