任务池

任务池

/// <author>cxg 2020-9-3</author>
/// 线程池处理异步任务队列，每个线程都有自己的任务队列
/// 支持d7以上版本，更低版本没有测试，支持跨OS

unit tasks;

interface

uses
  {$IFDEF mswindows}
  Windows,
  {$ENDIF}
  {$IFDEF posix}
  posix.Unistd, posix.Semaphore,
  {$ENDIF}
  Contnrs, SyncObjs, Classes, SysUtils;

type
  TCallBack = procedure(task: Pointer) of object;

type
  TThreadConf = class
  private
    fCallBack: TCallBack;
    fThreadNum: Cardinal;
    fWorkers: array of TThread;
    fCS: TCriticalSection;
    procedure freeThreads;
    procedure newThreads;
  public
    constructor Create(const threadNum: Cardinal = 0);
    destructor Destroy; override;
  public
    procedure startThreads;
    procedure stopThreads;
    procedure postTask(task: Pointer);
  public
    property onCallback: TCallBack read fCallBack write fCallBack;
    property threadNum: Cardinal read fThreadNum;
  end;

type
  TWorkThread = class(TThread)
  private
    fConf: TThreadConf;
    fQueue: TQueue;
    {$IFDEF mswindows}
    hsem: THandle; // 信号量
    {$ELSE}
    hsem: sem_t;
    {$ENDIF}
  public
    constructor Create(conf: TThreadConf);
    destructor Destroy; override;
  public
    procedure Execute; override;
    procedure push(task: Pointer);
  end;

function cpuNum: Cardinal;

implementation

var
  gIndex: Integer = 0;

function cpuNum: Cardinal;
{$IFDEF MSWINDOWS}
var
  si: SYSTEM_INFO;
{$ENDIF}
begin
  {$IFDEF MSWINDOWS}
  GetSystemInfo(si);
  Result := si.dwNumberOfProcessors;
  {$ELSE}
  Result := sysconf(_SC_NPROCESSORS_ONLN);
  {$ENDIF}
end;

{ TThreadConf }

procedure TThreadConf.postTask(task: Pointer);
var
  i: Integer;
begin
  fCS.Enter;
  try
    i := gIndex mod fThreadNum;
    inc(gIndex);
  finally
    fCS.Leave;
  end;
  TWorkThread(fWorkers[i]).push(task);
end;

constructor TThreadConf.Create(const threadNum: Cardinal = 0);
begin
  fCS := TCriticalSection.Create;
  fThreadNum := threadNum;
  if fThreadNum = 0 then
    fThreadNum := cpuNum;
  SetLength(fWorkers, fThreadNum);
  newThreads;
end;

destructor TThreadConf.Destroy;
begin
  freeThreads;
  FreeAndNil(fCS);
  inherited;
end;

procedure TThreadConf.freeThreads;
var
  i: Integer;
begin
  for i := 0 to fThreadNum - 1 do
  begin
    fWorkers[i].Terminate;
    fWorkers[i].WaitFor;
    FreeAndNil(fWorkers[i]);
  end;
end;

procedure TThreadConf.newThreads;
var
  i: Byte;
begin
  for i := 0 to fThreadNum - 1 do
    fWorkers[i] := TWorkThread.Create(Self);
end;

procedure TThreadConf.startThreads;
var
  i: Byte;
begin
  for i := 0 to fThreadNum - 1 do
    {$IFDEF unicode}
    fWorkers[i].Start;
    {$ELSE}
    fWorkers[i].Resume;
    {$ENDIF}
end;

procedure TThreadConf.stopThreads;
var
  i: Byte;
begin
  for i := 0 to fThreadNum - 1 do
    fWorkers[i].Suspend;
end;

{ TWorkThread }

constructor TWorkThread.Create(conf: TThreadConf);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  fConf := conf;
  fQueue := TQueue.Create;
  {$IFDEF mswindows}
  hsem := CreateSemaphore(nil, 0, 1, nil);
  {$ELSE}
  sem_init(hsem, 0, 0);
  {$ENDIF}
end;

destructor TWorkThread.Destroy;
begin
  FreeAndNil(fQueue);
  {$IFDEF mswindows}
  CloseHandle(hsem);
  {$ELSE}
  sem_destroy(hsem);
  {$ENDIF}
  inherited;
end;

procedure TWorkThread.push(task: Pointer);
begin
  fQueue.Push(task);
  {$IFDEF mswindows}
  ReleaseSemaphore(hsem, 1, nil);
  {$ELSE}
  sem_post(hsem);
  {$ENDIF}
end;

procedure TWorkThread.Execute;
var
  task: Pointer;

  procedure run;
  begin
    task := fQueue.Pop;
    if task <> nil then
      if Assigned(fConf.fCallBack) then
        fConf.fCallBack(task);
  end;

begin
  while not Self.Terminated do
  begin
    {$IFDEF mswindows}
    if WaitForSingleObject(hsem, INFINITE) = WAIT_OBJECT_0 then
      run;
    {$ELSE}
    if sem_wait(hsem) > 0 then
      run;
    {$ENDIF}
  end;
end;

end.