Worker thread template class with task queue (FIFO) without third-party components. FreePascal

taskworker.pas

unit taskworker;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type

  TWorkerTask=class(TObject)
    { TODO 1 : Task object }
  end;

  { TTaskWorker }

  TTaskWorker = class(TThread)
  private
    FThreadList: TThreadList;
    FUnblockEvent: pRTLEvent;
    procedure ClearTasks;
    function ExecuteWaiting: Boolean;
    function PopTask: TWorkerTask;
    procedure ProcessTask(ATask: TWorkerTask);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Execute; override;
    procedure PushTask(ATask: TWorkerTask);
    procedure TerminateWorker;
  end;

implementation

{ TTaskWorker }

function TTaskWorker.ExecuteWaiting: Boolean;
begin
  RTLeventWaitFor(FUnblockEvent);
  RTLeventResetEvent(FUnblockEvent);
  Result:=not Terminated;
end;

function TTaskWorker.PopTask: TWorkerTask;
var
  AList: TList;
  i: Integer;
begin
  Result:=nil;
  AList:=FThreadList.LockList;
  i:=AList.Count;
  if i>0 then
  begin
    Result:=TWorkerTask(AList[0]);
    AList.Delete(0);
  end;
  FThreadList.UnlockList;
end;

procedure TTaskWorker.ClearTasks;
var
  ATask: TWorkerTask;
begin
  repeat
     ATask:=PopTask;
     if Assigned(ATask) then
     begin
       { TODO : Save tasks for futher processing (for example after thread restart) }
       ATask.Free;
     end;
  until ATask=nil;
end;

constructor TTaskWorker.Create;
begin
  inherited Create(True);
  FreeOnTerminate:=False;
  FThreadList:=TThreadList.Create;
  FUnblockEvent:=RTLEventCreate;
end;

destructor TTaskWorker.Destroy;
begin
  RTLeventdestroy(FUnblockEvent);
  FThreadList.Free;
  inherited Destroy;
end;

procedure TTaskWorker.Execute;
var
  ATask: TWorkerTask;
begin
  while not Terminated do
  begin
    if not ExecuteWaiting then break;
    repeat
      ATask:=PopTask;
      if Assigned(ATask) then
        ProcessTask(ATask);
    until (ATask=nil) or Terminated;
  end;
  ClearTasks;
end;

procedure TTaskWorker.ProcessTask(ATask: TWorkerTask);
begin
  { TODO 1 : Process worker's task }
  ATask.Free;
end;

procedure TTaskWorker.PushTask(ATask: TWorkerTask);
begin
  FThreadList.Add(ATask);
  RTLeventSetEvent(FUnblockEvent);
end;

procedure TTaskWorker.TerminateWorker;
begin
  Terminate;
  RTLeventSetEvent(FUnblockEvent);
end;

end.