Skip to content

Instantly share code, notes, and snippets.

@Al-Muhandis
Last active Mar 11, 2019
Embed
What would you like to do?
Worker thread template class with task queue (FIFO) without third-party components. FreePascal
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.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment