Deutsch (de) English (en) español (es) français (fr) 日本語 (ja) polski (pl) português (pt) русский (ru) slovenčina (sk) 中文（中国大陆）‎ (zh_CN)

你需要多线程吗?

• blocking handles, like network communications(屏蔽处理,比如网络通信)
• 同时使用多个处理器 (SMP)
• 算法和库调用，必须通过一个 API 调用，如不能被分解成更小的部分。

If you want to use multi-threading to increase speed by using multiple processors simultaneously, check if your current program now uses all 100% resources of 1 core CPU (for example, your program can actively use input-output operations, e.g. writing to file; this takes a lot of time, but doesn't load CPU; in this case your program will not be faster with multiple threads). Also check if optimisation level is set to maximum (3). When switching optimisation level from 1 to 3, a program may become about 5 times faster.

多线程单元

program MyMultiThreadedProgram;
{$mode objfpc}{$H+}
uses
{$ifdef unix} cthreads, cmem, // the c memory manager is on some systems much faster for multi-threading(C内存管理器在某些系统中使多线程运行更快) {$endif}
Interfaces, // this includes the LCL widgetset 引入LCL 部件工具箱
Forms
{ you can add units here },

 This binary has no thread support compiled in. (二进制文件编译时没有线程支持)
Recompile the application with a thread-driver in the program uses clause before other units using thread.(在引用线程单元前引用了其他单元)


Note: 方法摘要在：自FPC 2.4.4 弃用。它被Start代替。

Terminated : boolean;


If the thread has a loop (and this is typical), the loop should be exited when Terminated is true (it is false by default). Within each pass, the value of Terminated must be checked, and if it is true then the loop should be exited as quickly as is appropriate, after any necessary cleanup. Bear in mind that the Terminate method does not do anything by default: the .Execute method must explicitly implement support for it to quit its job.

(如果线程中包含循环（这是典型的），当 Terminated 为True时退出循环（默认为 False）。每次循环都将检查 Terminated值，如果为真将退出循环，之后做些必要的清理。牢记 Terminate方法不做任何事情，默认情况下：.Execute 方法实现退出循环后的操作。)

To do this, a TThread method called Synchronize exists. Synchronize requires a method within the thread (that takes no parameters) as an argument. When you call that method through Synchronize(@MyMethod), the thread execution will be paused, the code of MyMethod will be called from the main thread, and then the thread execution will be resumed.

The exact working of Synchronize depends on the platform, but basically it does this: (同步的具体工作取决于平台，它基本上是：)

• 发送消息到主消息队列并进入睡眠
• eventually the main thread processes the message and calls MyMethod. This way MyMethod is called without context, that means not during a mouse down event or during paint event, but after.
• 主线程执行 MyMethod后，唤醒睡眠的线程和下条消息
• 之后，线程继续执行

  Type
private
fStatusText : string;
procedure ShowStatus;
protected
procedure Execute; override;
public
Constructor Create(CreateSuspended : boolean);
end;

begin
FreeOnTerminate := True;
inherited Create(CreateSuspended);
end;

// this method is executed by the mainthread and can therefore access all GUI elements.
begin
Form1.Caption := fStatusText;
end;

var
newStatus : string;
begin
Synchronize(@Showstatus);
while (not Terminated) and ([any condition required]) do
begin
...
[here goes the code of the main thread loop]
...
if NewStatus <> fStatusText then
begin
fStatusText := newStatus;
Synchronize(@Showstatus);
end;
end;
end;

  var
begin
...
[Here the code initialises anything required before the threads starts executing]
...
end;

If you want to make your application more flexible you can create an event for the thread; this way your synchronized method won't be tightly coupled with a specific form or class: you can attach listeners to the thread's event. Here is an example:

(如果想使你的应用更加灵活，可以创建一个事件的线程；这样一来,synchronized方法将不会被特定窗体或类紧耦合：你可以监听线程的事件。)

  Type
TShowStatusEvent = procedure(Status: String) of Object;

private
fStatusText : string;
FOnShowStatus: TShowStatusEvent;
procedure ShowStatus;
protected
procedure Execute; override;
public
Constructor Create(CreateSuspended : boolean);
property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
end;

begin
FreeOnTerminate := True;
inherited Create(CreateSuspended);
end;

// this method is executed by the mainthread and can therefore access all GUI elements.
begin
if Assigned(FOnShowStatus) then
begin
FOnShowStatus(fStatusText);
end;
end;

var
newStatus : string;
begin
Synchronize(@Showstatus);
while (not Terminated) and ([any condition required]) do
begin
...
[here goes the code of the main thread loop]
...
if NewStatus <> fStatusText then
begin
fStatusText := newStatus;
Synchronize(@Showstatus);
end;
end;
end;

  Type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
procedure ShowStatus(Status: string);
public
{ public declarations }
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
inherited;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

// FreeOnTerminate is true so we should not write:
inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
end;

procedure TForm1.ShowStatus(Status: string);
begin
Label1.Caption := Status;
end;

特殊处理

Windows堆栈检查

There is a potential headache in Windows with Threads if you use the -Ct (stack check) switch. For reasons not so clear the stack check will "trigger" on any TThread.Create if you use the default stack size. The only work-around for the moment is to simply not use -Ct switch. Note that it does NOT cause an exception in the main thread, but in the newly created one. This "looks" like if the thread was never started.

A good code to check for this and other exceptions which can occur in thread creation is:

MyThread := TThread.Create(False);
raise MyThread.FatalException;

This code will assure that any exception which occurred during thread creation will be raised in your main thread.

多线程包

Packages which uses multi-threading should add the -dUseCThreads flag to the custom usage options. Open the package editor of the package, then Options > Usage > Custom and add -dUseCThreads. This will define this flag to all projects and packages using this package, including the IDE. The IDE and all new applications created by the IDE have already the following code in their .lpr file:

uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cmem, // the c memory manager is on some systems much faster for multi-threading
{$ENDIF}{$ENDIF}

Heaptrc

You can not use the -gh switch with the cmem unit. The -gh switch uses the heaptrc unit, which extends the heap manager. Therefore the heaptrc unit must be used after the cmem unit.

uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cmem, // the c memory manager is on some systems much faster for multi-threading
{$ENDIF}{$ENDIF}
heaptrc,

Lazarus调试多线程应用程序

Lzarus上使用GDB进行调试，它功能齐全、稳定。不过，在一些Linux发行版上存在一些问题。

调试输出

In a single threaded application, you can simply write to console/terminal/whatever and the order of the lines is the same as they were written. In multi-threaded application things are more complicated. If two threads are writing, say a line is written by thread A before a line by thread B, then the lines are not necessarily written in that order. It can even happen, that a thread writes its output, while the other thread is writing a line.While under linux (maybe) you'll get proper DebugLn() output, under win32 you can get exceptions (probably DiskFull) because of DebugLn() usage outside of main thread.So, to avoid headaches use DebugLnThreadLog() mentioned below.

LCLProc 单元包含几个过程，让每个线程写入它自己的日志文件：

  procedure DbgOutThreadLog(const Msg: string); overload;
procedure DebuglnThreadLog; overload;

 DebuglnThreadLog(['Some text ',123]);


 rm -f Log* && ./project1


Linux

X服务器上的桌面管理器可能会挂掉。如应用程序已捕获鼠标/键盘gdb暂停，X服务器等待应用程序响应。

Since it depends where gdb stops your program in some cases some tricks may help: 为Ubuntu x64设置项目选项用于调试所需的额外信息文件...

 工程菜单 -> 工程选项 -> 编译选项中的调试项，勾选使用外部gdb调试语法文件(-Xg)。


 X :1 &


It will open, and when you switch to another desktop (the one you are working with pressing CTRL+ALT+F7), you will be able to go back to the new graphical desktop with CTRL+ALT+F8 (if this combination does not work, try with CTRL+ALT+F2... this one worked on Slackware).

Then you could, if you want, create a desktop session on the X started with:

 gnome-session --display=:1 &


Then, in Lazarus, on the run parameters dialog for the project, check "Use display" and enter :1.

Instead of creating a new X session, one can use Xnest. Xnest is a X session on a window. Using it X server didn't lock while debugging threads, and it's much easier to debug without keeping changing terminals.

 Xnest :1 -ac


Lazarus 部件工具箱接口

The win32, the gtk and the carbon interfaces support multi-threading. This means, TThread, critical sections and Synchronize work. But they are not thread safe. This means only one thread at a time can access the LCL. And since the main thread should never wait for another thread, it means only the main thread is allowed to access the LCL, which means anything that has to do with TControl, Application and LCL widget handles. There are some thread safe functions in the LCL. For example most of the functions in the FileUtil unit are thread safe.

使用SendMessage/PostMessage进行线程间通信

The difference between SendMessage and PostMessage is the way that they return control to the calling thread. With SendMessage control is not returned until the window that the message was sent to has completed processing the sent message, however with PostMessage control is returned immediately.

(SendMessage 和 PostMessage区别在于处理调用线程的方式。SendMessage 在接收到返回值后才继续执行，而PostMessage则不会等待。)

Here is an example of how a secondary thread could send text to be displayed in an LCL control to the main thread:

const
WM_GOT_ERROR           = LM_USER + 2004;
WM_VERBOSE             = LM_USER + 2005;

procedure VerboseLog(Msg: string);
var
PError: PChar;
begin
if MessageHandler = 0 then Exit;
PError := StrAlloc(Length(Msg)+1);
StrCopy(PError, PChar(Msg));
PostMessage(formConsole.Handle, WM_VERBOSE, Integer(PError), 0);
end;

const
WM_GOT_ERROR           = LM_USER + 2004;
WM_VERBOSE             = LM_USER + 2005;

type
{ TformConsole }

TformConsole = class(TForm)
DebugList: TListView;
// ...
private
procedure HandleDebug(var Msg: TLMessage); message WM_VERBOSE;
end;

var
formConsole: TformConsole;

implementation

....

{ TformConsole }

procedure TformConsole.HandleDebug(var Msg: TLMessage);
var
Item: TListItem;
MsgStr: PChar;
MsgPasStr: string;
begin
MsgStr := PChar(Msg.wparam);
MsgPasStr := StrPas(MsgStr);
Item.Caption := TimeToStr(SysUtils.Now);
Item.MakeVisible(False);
//f/TrayControl.SetError(MsgPasStr);
end;

end.

临界区

A critical section is an object used to make sure, that some part of the code is executed only by one thread at a time. A critical section needs to be created/initialized before it can be used and be freed when it is not needed anymore.

(临界区用来确保代码的某些部分同一时间只能由一个线程执行。临界区需要被创建/初始化后才能使用，不需要时释放它。)

 MyCriticalSection: TRTLCriticalSection;


 InitializeCriticalSection(MyCriticalSection);


EnterCriticalSection(MyCriticalSection);
try
// 访问变量、写入文件、发送网络数据包等等
finally
LeaveCriticalSection(MyCriticalSection);
end;

 DeleteCriticalSection(MyCriticalSection);


As an alternative, you can use a TCriticalSection object. The creation does the initialization, the Enter method does the EnterCriticalSection, the Leave method does the LeaveCriticalSection and the destruction of the object does the deletion.

(作为代替者，你可以使用TCriticalSection对象。创建即初始化临界区，进入临界区使用 EnterCriticalSection，离开时使用 LeaveCriticalSection，对象销毁时删除临界区。)

等待另一个线程

{ TThreadA }

begin
// create event
WaitForB:=RTLEventCreate;
while not Application.Terminated do begin
// wait infinitely (until B wakes A)
RtlEventWaitFor(WaitForB);
end;
end;

var
i: Integer;
begin
Counter:=0;
while not Application.Terminated do begin
// B: Working ...
Sleep(1500);
inc(Counter);
// wake A
end;
end;

Note: RtlEventSetEvent can be called before RtlEventWaitFor. Then RtlEventWaitFor will return immediately. Use RTLeventResetEvent to clear a flag.

Note: RtlEventSetEvent可以在RtlEventWaitFor之前被调用。之后RtlEventWaitFor将立即返回。使用RTLeventResetEvent清除标记。

Fork

When forking in a multi-threaded application, be aware that any threads created and running BEFORE the fork (or fpFork) call, will NOT be running in the child process. As stated on the fork() man page, any threads that were running before the fork call, their state will be undefined.

So be aware of any threads initializing before the call (including on the initialization section). They will NOT work.

分布式计算

The next higher steps after multi threading is running the threads on multiple machines.

• 可以使用TCP组件像synapse、lnet 或 indy通信。这给你最大的灵活性和主要用于松散连接的客户端/服务器应用程序。
• 你可以使用消息传递库，像MPICH，用于HPC（高性能计算）集群上。

外部线程

To make Free Pascal's threading system work properly, each newly created FPC thread needs to be initialized (more exactly, the exception, I/O system and threadvar system per thread needs to be initialized so threadvars and heap are working). That is fully automatically done for you if you use BeginThread (or indirectly by using the TThread class). However, if you use threads that were created without BeginThread (i.e. external threads), additional work (currently) might be required. External threads also include those that were created in external C libraries (.DLL/.so).

Things to consider when using external threads (might not be needed in all or future compiler versions):

• Do not use external threads at all - use FPC threads. If can you can get control over how the thread is created, create the thread by yourself by using BeginThread.

If the calling convention doesn't fit (e.g. if your original thread function needs cdecl calling convention but BeginThread needs pascal convention, create a record, store the original required thread function in it, and call that function in your pascal thread function:

type

Data: Pointer;           //original data
end;

// The Pascal thread calls the cdecl function
function C2P_Translator(FuncData: pointer) : ptrint;
var
begin
end;

var
begin
// this is the desired cdecl thread function
// this creates the Pascal thread
end;

• Initialize the FPC's threading system by creating a dummy thread. If you don't create any Pascal thread in your app, the thread system won't be initialized (and thus threadvars won't work and thus heap will not work correctly).
type
procedure execute;override;
end;

procedure tc.execute;
begin
end;

{ main program }
begin
with tc.create(false) do
begin
waitfor;
free;
end;
{ ... your code follows }
end.

(After the threading system is initialized, the runtime may set the system variable "IsMultiThread" to true which is used by FPC routines to perform locks here and there. You should not set this variable manually.)

• If for some reason this doesn't work for you, try this code in your external thread function:
function ExternalThread(param: Pointer): LongInt; stdcall;
var
begin

{ do something threaded here ... }

Result:=0;
end;

识别外部线程

1. 询问操作系统当前应用程序线程的ID

GetCurrentThreadID() // Windows;
TThreadID(pthread_self) // Linux;