Multithreaded Application Tutorial/zh CN

From Lazarus wiki
Revision as of 12:06, 1 July 2014 by Wangyouworld (talk | contribs) (Multithreaded Application Tutorial/zh CN)

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

概述

这个页面将试图解释如何在Free Pascal 和 Lazarus上编写和调试一个多线程应用程序。一个多线程应用程序创建两个或多个线程同时执行任务。如果你正需要使用多线程,请阅读"你需要多线程吗?",以确定你是否真的需要;这可以避免些麻烦。

One of the threads is called the Main Thread. The Main Thread is the one that is created by the Operating System once our application starts. The Main Thread must be the only thread that updates the components that interfaces with the user: otherwise, the application may hang.

(一个线程被称为主线程,主线程是在应用程序启动时由操作系统创建。主线程"必须"更新组件或与用户交互:否则,应用程序可能会被挂起。)

其主要思想是:应用程序使用第二个线程在后台处其他事情,同时用户可以继续使用主线程工作。

线程的另一个用途是为了更好的响应应用程序。如,你创建了一个应用程序,在应用程序启动时,用户按下按钮启动一个大的任务……处理中……之后,程序停止响应,这让用户觉得应用程序假死了,在用户体验上这很不好。如果大的任务在另一个线程中运行,应用程序保持响应,它就像在闲置,在本例中它是个不错的选择。不过,在启用线程之前,你需要禁用表单按钮,以避用户启动多个线程。

还有,服务器应用程序在使用多线程后,它能够同时响应多个客户端的请求。

你需要多线程吗?

如果你刚想使用多线程,而只是想让你的应用程序长时间运行任务而不失去响应,那么,多线程可能超过你的需要。多线程应用程序难以调试并且很复杂,多数情况下你不需要多线程。单线程就足够了。如果你能将耗时的任务分隔成几块,并使用Application.ProcessMessages。这种方法让LCL处理所有等待的消息并返回。其核心是,在长时间运行任务时定期调用Application.ProcessMessages以处理用户点击了什么东西,或者重绘进度条等等。

例如:读取一个大文件并处理它。 参看 examples/multithreading/singlethreadingexample1.lpi。

使用多线程

  • 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.

你想使用多线程使用多个处理器来提高速度,检查当前程序使用1个核心的CPU上的100%资源(如,你的程序可以积极使用输入输出操作,如写入文件等等,这需要大量时间,但CPU没有负载;在这种情况下,你的程序将不会比多种线程快。)检查优化级别设置为最大(3)。切换优化级别1到3,程序运行可能会快5倍。

多线程单元

在Windows上你不需要任何特殊单元。

然而在Linux、Mac OS X和FreeBSD上,你需要cthreads单元,并且,必须项目中第一个引入的单元(项目源文件,通常是 .lpr文件)!

所以,你的Lazarus应用程序代码看起来应该是:

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 },

如果你忘记了这一点,使用TThread启动应用程序时,你会得到这样的错误:

 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-icon.png

Note: 提示"mcount"未找到的错误。在你的单元里包含了多线程代码,你需要添加 cthreads单元或使用智能链接。

Note-icon.png

Note: "Project raised exception class 'RunError(232)'" in procedure SYSTEM_NOTHREADERROR (项目引发的异常类)错误,你的代码里需要线程,你需要添加 cthreads单元。

TThread类

下面的例子可以在 examples/multithreading/ 目录中找到。

若要创建一个多线程的应用程序,最简单的方法是使用 TThread 类。This class permits the creation of an additional thread (alongside the main thread) in a simple way.(这个线程允许在主线程上创建一个附加线程)。)通常你只需要重写 2 个方法:创建构造函数(constructor)和执行方法(Execute)。

在构造函数中,设置线程运行前初始化需要的变量,在TThread原始构造函数中有一参数Suspended,设置Suspended = True防止在创建后自动启动线程。设置为False,则在在调用Start方法后才执行。

Note-icon.png

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

FPC 2.0.1及更高版本,TThread.Create有一个隐含的堆栈大小参数。根据需要,你可以改变默认堆栈的大小。深层递归过程是个很好的例子。如果你不指定堆栈大小,将使用系统默认的大小。

重写Execute方法,编写将在线程中执行的代码。

TThread 类有一个重要属性:

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.

(要这样做,可以在TThread 方法调用Synchronize。以同步线程中的方法(不带参数)作为参数。当你调用Synchronize(@MyMethod),线程将暂停执行,并从主线程中调用MyMethod,之后线程恢复。)

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后,唤醒睡眠的线程和下条消息
  • 之后,线程继续执行

另外,还有一重要属性: TThread: FreeOnTerminate。为True时,线程停止(.Execute 方法)后自动释放。否则,需要手动释放。

示例:

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

  constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := True;
    inherited Create(CreateSuspended);
  end;

  procedure TMyThread.ShowStatus;
  // this method is executed by the mainthread and can therefore access all GUI elements.
  begin
    Form1.Caption := fStatusText;
  end;
 
  procedure TMyThread.Execute;
  var
    newStatus : string;
  begin
    fStatusText := 'TMyThread Starting...';
    Synchronize(@Showstatus);
    fStatusText := 'TMyThread Running...';
    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
    MyThread : TMyThread;
  begin
    MyThread := TMyThread.Create(True); // This way it doesn't start automatically
    ...
    [Here the code initialises anything required before the threads starts executing]
    ...
    MyThread.Start;
  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;

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

  constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := True;
    inherited Create(CreateSuspended);
  end;

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

  procedure TMyThread.Execute;
  var
    newStatus : string;
  begin
    fStatusText := 'TMyThread Starting...';
    Synchronize(@Showstatus);
    fStatusText := 'TMyThread Running...';
    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 }
      MyThread: TMyThread; 
      procedure ShowStatus(Status: string);
    public
      { public declarations }
    end;

  procedure TForm1.FormCreate(Sender: TObject);
  begin
    inherited;
    MyThread := TMyThread.Create(true);
    MyThread.OnShowStatus := @ShowStatus;
  end;

  procedure TForm1.FormDestroy(Sender: TObject);
  begin
    MyThread.Terminate;

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

  procedure TForm1.Button1Click(Sender: TObject);
  begin
   MyThread.Start;
  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);
if Assigned(MyThread.FatalException) then
  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}
  cthreads,
  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}
  cthreads,
  cmem, // the c memory manager is on some systems much faster for multi-threading
  {$ENDIF}{$ENDIF}
  heaptrc,

SMP支持

The good news is that if your application works properly multi-threaded this way, it is already SMP enabled!

Lazarus调试多线程应用程序

The debugging on Lazarus requires GDB and is rapidly becoming more and more fully featured and stable. However, there still exists a few Linux distributions with some problems.

调试输出

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.

The LCLProc unit contains several functions, to let each thread write to its own log file:

  procedure DbgOutThreadLog(const Msg: string); overload;
  procedure DebuglnThreadLog(const Msg: string); overload;
  procedure DebuglnThreadLog(Args: array of const); overload;
  procedure DebuglnThreadLog; overload;

For example: Instead of writeln('Some text ',123); use

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

This will append a line 'Some text 123' to Log<PID>.txt, where <PID> is the process ID of the current thread.

It is a good idea to remove the log files before each run:

 rm -f Log* && ./project1

Linux

If you try to debug a multi-threaded application on Linux, you will have one big problem: the Desktop Manager on X server can hang. This happens for instance when the application has captured the mouse/keyboard and was paused by gdb and the X server waits for your application. When that happens you can simply log in from another computer and kill the gdb or exit out of that session by pressing CTRL+ALT+F3 and kill gdb. Alternatively you can restart the window manager: enter sudo /etc/init.d/gdm restart. This will restart the desktop manager and get you back into your desktop.

Since it depends where gdb stops your program in some cases some tricks may help: for Ubuntu x64 set the Project options for debugging required extra information file...

 Project Options -> Compiler Options -> Linking -> Debugging: Check Use external gdb debug symbols file (-Xg).

The other option is to open anotner X desktop, run the IDE/gdb on one and the application on the other, so that only the test desktop freezes. Create a new instance of X with:

 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.

Now the application will run on the second X server and you will be able to debug it on the first one.

This was tested with Free Pascal 2.0 and Lazarus 0.9.10 on Windows and Linux.



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.

The command line to run Xnest is

 Xnest :1 -ac

to create a X session on :1, and disabling access control.

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进行线程间通信

Only one thread in an application should call LCL APIs, usually the main thread. Other threads can make use of the LCL through a number of indirect methods, one good option being the usage of SendMessage or PostMessage. LCLIntf.SendMessage and LCLIntf.PostMessage will post a message directed to a window in the message pool of the application.

See also the documentation for these routines:

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.

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;

And an example of how to handle this message from a window:

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 := DebugList.Items.Add;
  Item.Caption := TimeToStr(SysUtils.Now);
  Item.SubItems.Add(MsgPasStr);
  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.

Critical sections are normally used this way:

Declare the section (globally for all threads which should access the section):

 MyCriticalSection: TRTLCriticalSection;

Create the section:

 InitializeCriticalSection(MyCriticalSection);

Run some threads. Doing something exclusively

EnterCriticalSection(MyCriticalSection);
try
  // access some variables, write files, send some network packets, etc
finally
  LeaveCriticalSection(MyCriticalSection);
end;

After all threads terminated, free it:

 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.

For example: 5 threads incrementing a counter. See lazarus/examples/multithreading/criticalsectionexample1.lpi

BEWARE: There are two sets of the above 4 functions. The RTL and the LCL ones. The LCL ones are defined in the unit LCLIntf and LCLType. Both work pretty much the same. You can use both at the same time in your application, but you should not use a RTL function with an LCL Critical Section and vice versus.


共享变量

If some threads share a variable, that is read only, then there is nothing to worry about. Just read it. But if one or several threads changes the variable, then you must make sure, that only one thread accesses the variables at a time.

For example: 5 threads incrementing a counter. See lazarus/examples/multithreading/criticalsectionexample1.lpi

等待另一个线程

If a thread A needs a result of another thread B, it must wait, till B has finished.

Important: The main thread should never wait for another thread. Instead use Synchronize (see above).

See for an example: lazarus/examples/multithreading/waitforexample1.lpi

{ TThreadA }

procedure TThreadA.Execute;
begin
  Form1.ThreadB:=TThreadB.Create(false);
  // create event
  WaitForB:=RTLEventCreate;
  while not Application.Terminated do begin
    // wait infinitely (until B wakes A)
    RtlEventWaitFor(WaitForB);
    writeln('A: ThreadB.Counter='+IntToStr(Form1.ThreadB.Counter));
  end;
end;

{ TThreadB }

procedure TThreadB.Execute;
var
  i: Integer;
begin
  Counter:=0;
  while not Application.Terminated do begin
    // B: Working ...
    Sleep(1500);
    inc(Counter);
    // wake A
    RtlEventSetEvent(Form1.ThreadA.WaitForB);
  end;
end;
Note-icon.png

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

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.

并行程序/循环

A special case of multi threading is running a single procedure in parallel. See Parallel procedures.

分布式计算

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

  • You can use one of the TCP suites like synapse, lnet or indy for communications. This gives you maximum flexibility and is mostly used for loosely connected Client / Server applications.
  • You can use message passing libraries like MPICH, which are used for HPC (High Performance Computing) on clusters.


外部线程

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
 TCdeclThreadFunc = function (user_data:Pointer):Pointer;cdecl;

 PCdeclThreadFuncData = ^TCdeclThreadFuncData;
 TCdeclThreadFuncData = record
   Func: TCdeclThreadFunc;  //cdecl function
   Data: Pointer;           //original data
 end;

// The Pascal thread calls the cdecl function
function C2P_Translator(FuncData: pointer) : ptrint;
var
  ThreadData: TCdeclThreadFuncData;
begin
  ThreadData := PCdeclThreadFuncData(FuncData)^;
  Result := ptrint(ThreadData.Func(ThreadData.Data));
end;

procedure CreatePascalThread;
var
  ThreadData: PCdeclThreadFuncData;
begin
  New(ThreadData);
  // this is the desired cdecl thread function
  ThreadData^.Func := func;
  ThreadData^.Data := user_data;
  // this creates the Pascal thread
  BeginThread(@C2P_Translator, ThreadData );
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
   tc = class(tthread)
     procedure execute;override;
   end;

   procedure tc.execute;
   begin
   end;

{ main program } 
begin
  { initialise threading system }
   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
  tm: TThreadManager;
begin
  GetThreadManager(tm);
  tm.AllocateThreadVars;
  InitThread(1000000); // adjust inital stack size here
  
  { do something threaded here ... }
    
  Result:=0;
end;


识别外部线程

Sometimes you even don't know if you have to deal with external threads (e.g. if some C library makes a callback). This can help to analyse this:

1. Ask the OS for the ID of the current thread at your application's start

Win32: GetCurrentThreadID();
Darwin: GetThreadID();  
Linux: TThreadID(pthread_self);

2. Ask again for the ID of the current thread inside the thread function and compare this by the result of step 1.

放弃时间片

ThreadSwitch()

Note-icon.png

Note: Do not use the Windows trick Sleep(0) as this won't work on all platforms.

参见