Nandlal Kumar
Nandlal Kumar

Reputation: 31

How to check if a thread is currently running

I am designing a thread pool with following features.

Here is the code:

unit ThreadUtilities;

interface
uses
Windows, SysUtils, Classes;

type
    EThreadStackFinalized = class(Exception);
    TSimpleThread = class;

    // Thread Safe Pointer Queue
    TThreadQueue = class
    private
        FFinalized: Boolean;
        FIOQueue: THandle;
    public
        constructor Create;
        destructor Destroy; override;
        procedure Finalize;
        procedure Push(Data: Pointer);
        function Pop(var Data: Pointer): Boolean;
        property Finalized: Boolean read FFinalized;
    end;

    TThreadExecuteEvent = procedure (Thread: TThread) of object;

    TSimpleThread = class(TThread)
    private
        FExecuteEvent: TThreadExecuteEvent;
    protected
        procedure Execute(); override;
    public
        constructor Create(CreateSuspended: Boolean; ExecuteEvent: TThreadExecuteEvent; AFreeOnTerminate: Boolean);
    end;

    TThreadPoolEvent = procedure (Data: Pointer; AThread: TThread) of Object;

    TThreadPool = class(TObject)
    private
        FThreads: TList;
        fis32MaxThreadCount : Integer;
        FThreadQueue: TThreadQueue;
        FHandlePoolEvent: TThreadPoolEvent;
        procedure DoHandleThreadExecute(Thread: TThread);
        procedure SetMaxThreadCount(const pis32MaxThreadCount : Integer);
        function GetMaxThreadCount : Integer;

    public
        constructor Create( HandlePoolEvent: TThreadPoolEvent; MaxThreads: Integer = 1); virtual;
        destructor Destroy; override;
        procedure Add(const Data: Pointer);
        property MaxThreadCount : Integer read GetMaxThreadCount write SetMaxThreadCount;
    end;


implementation



constructor      TThreadQueue.Create;
begin         
    //-- Create IO Completion Queue
    FIOQueue := CreateIOCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
    FFinalized := False;
end;

destructor TThreadQueue.Destroy;
begin
    //-- Destroy Completion Queue
    if (FIOQueue = 0) then
        CloseHandle(FIOQueue);
    inherited;
end;

procedure TThreadQueue.Finalize;
begin
    //-- Post a finialize pointer on to the queue
    PostQueuedCompletionStatus(FIOQueue, 0, 0, Pointer($FFFFFFFF));
    FFinalized := True;
end;


function TThreadQueue.Pop(var Data: Pointer): Boolean;
var
    A: Cardinal;
    OL: POverLapped;
begin
    Result := True;
    if (not FFinalized) then 
        //-- Remove/Pop the first pointer from the queue or wait
        GetQueuedCompletionStatus(FIOQueue, A, Cardinal(Data), OL, INFINITE);

    //-- Check if we have finalized the queue for completion
    if FFinalized or (OL = Pointer($FFFFFFFF)) then begin
        Data := nil;
        Result := False;
        Finalize;
    end;
end;

procedure TThreadQueue.Push(Data: Pointer);
begin        
    if FFinalized then
        Raise EThreadStackFinalized.Create('Stack is finalized');
    //-- Add/Push a pointer on to the end of the queue
    PostQueuedCompletionStatus(FIOQueue, 0, Cardinal(Data), nil);
end;

{ TSimpleThread }

constructor TSimpleThread.Create(CreateSuspended: Boolean;
  ExecuteEvent: TThreadExecuteEvent; AFreeOnTerminate: Boolean);
begin
    FreeOnTerminate := AFreeOnTerminate;
    FExecuteEvent := ExecuteEvent;
    inherited Create(CreateSuspended);
end;

Changed the code as suggested by J... also added critical sections but the problem i am facing now is that when i am trying call multiple task only one thread is being used, Lets say if i added 5 threads in the pool then only one thread is being used which is thread 1. Please check my client code as well in the below section.

procedure TSimpleThread.Execute;
begin
    //    if Assigned(FExecuteEvent) then
//        FExecuteEvent(Self);
    while not self.Terminated do begin
    try
//      FGoEvent.WaitFor(INFINITE);
//      FGoEvent.ResetEvent;
      EnterCriticalSection(csCriticalSection);
      if self.Terminated then break;


      if Assigned(FExecuteEvent) then
        FExecuteEvent(Self);
    finally
      LeaveCriticalSection(csCriticalSection);
//      HandleException;
    end;
end;
end;

In the Add method, how can I check if there is any thread which is not busy, if it is not busy then reuse it else create a new thread and add it in ThreadPool list?

{ TThreadPool }
procedure TThreadPool.Add(const Data: Pointer);
begin
  FThreadQueue.Push(Data);
//  if FThreads.Count < MaxThreadCount then
//  begin
//    FThreads.Add(TSimpleThread.Create(False, DoHandleThreadExecute, False));
//  end;
end;

constructor TThreadPool.Create(HandlePoolEvent: TThreadPoolEvent;
  MaxThreads: Integer);
begin
    FHandlePoolEvent := HandlePoolEvent;
    FThreadQueue := TThreadQueue.Create;
    FThreads := TList.Create;
    FThreads.Add(TSimpleThread.Create(False, DoHandleThreadExecute, False));
end;

destructor TThreadPool.Destroy;
var
    t: Integer;
begin
    FThreadQueue.Finalize;
    for t := 0 to FThreads.Count-1 do
        TThread(FThreads[t]).Terminate;
    while (FThreads.Count =  0) do begin
        TThread(FThreads[0]).WaitFor;
        TThread(FThreads[0]).Free;
        FThreads.Delete(0);
    end;
    FThreadQueue.Free;
    FThreads.Free;
    inherited;
end;

procedure TThreadPool.DoHandleThreadExecute(Thread: TThread);
var
    Data: Pointer;
begin
    while FThreadQueue.Pop(Data) and (not TSimpleThread(Thread).Terminated) do begin
        try
            FHandlePoolEvent(Data, Thread);
        except
        end;
    end;
end;

function TThreadPool.GetMaxThreadCount: Integer;
begin
  Result := fis32MaxThreadCount;
end;

procedure TThreadPool.SetMaxThreadCount(const pis32MaxThreadCount: Integer);
begin
  fis32MaxThreadCount := pis32MaxThreadCount;
end;

end.

Client Code : This the client i created to log the data in text file : unit ThreadClient;

interface

uses Windows, SysUtils, Classes, ThreadUtilities;

type
    PLogRequest = ^TLogRequest;
    TLogRequest = record
        LogText: String;
    end;

    TThreadFileLog = class(TObject)
    private
        FFileName: String;
        FThreadPool: TThreadPool;
        procedure HandleLogRequest(Data: Pointer; AThread: TThread);
    public
        constructor Create(const FileName: string);
        destructor Destroy; override;
        procedure Log(const LogText: string);
        procedure SetMaxThreadCount(const pis32MaxThreadCnt : Integer);
    end;

implementation

(* Simple reuse of a logtofile function for example *)
procedure LogToFile(const FileName, LogString: String);
var
    F: TextFile;
begin
    AssignFile(F, FileName);
    if not FileExists(FileName) then
        Rewrite(F)
    else
        Append(F);
    try
        Writeln(F, DateTimeToStr(Now) + ': ' + LogString);
    finally
        CloseFile(F);
    end;
end;

constructor TThreadFileLog.Create(const FileName: string);
begin
    FFileName := FileName;
    //-- Pool of one thread to handle queue of logs
    FThreadPool := TThreadPool.Create(HandleLogRequest, 5);
end;

destructor TThreadFileLog.Destroy;
begin
    FThreadPool.Free;
    inherited;
end;

procedure TThreadFileLog.HandleLogRequest(Data: Pointer; AThread: TThread);
var
    Request: PLogRequest;
    los32Idx : Integer;
begin
  Request := Data;
  try
    for los32Idx := 0 to 100 do
    begin
      LogToFile(FFileName, IntToStr( AThread.ThreadID) + Request^.LogText);
    end;
  finally
    Dispose(Request);
  end;
end;

procedure TThreadFileLog.Log(const LogText: string);
var
    Request: PLogRequest;
begin
    New(Request);
    Request^.LogText := LogText;
    FThreadPool.Add(Request);
end;
procedure TThreadFileLog.SetMaxThreadCount(const pis32MaxThreadCnt: Integer);
begin
  FThreadPool.MaxThreadCount := pis32MaxThreadCnt;
end;

end.

This is the form application where i added three buttons, each button click will write some value to the file with thread id and text msg. But the problem is thread id is always same

unit ThreadPool;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ThreadClient;

type
  TForm5 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private declarations }
    fiFileLog : TThreadFileLog;
  public
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}

procedure TForm5.Button1Click(Sender: TObject);
begin
  fiFileLog.Log('Button one click');
end;

procedure TForm5.Button2Click(Sender: TObject);
begin
  fiFileLog.Log('Button two click');
end;

procedure TForm5.Button3Click(Sender: TObject);
begin
  fiFileLog.Log('Button three click');
end;

procedure TForm5.Edit1Change(Sender: TObject);
begin
  fiFileLog.SetMaxThreadCount(StrToInt(Edit1.Text));
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  fiFileLog := TThreadFileLog.Create('C:/test123.txt');
end;

end.

Upvotes: 1

Views: 2518

Answers (1)

J...
J...

Reputation: 31393

First, and probably most strongly advisable, you might consider using a library like OmniThread to implement a threadpool. The hard work is done for you and you will likely end up making a substandard and buggy product with a roll-your-own solution. Unless you have special requirements this is probably the fastest and easiest solution.

That said, if you want to try to do this...

What you might consider is to just make all of the threads in your pool at startup rather than on-demand. If the server is going to busy at any point then it will eventually end up with a pool of MaxThreadCount soon enough anyway.

In any case, if you want to keep a pool of threads alive and available for work then they would need to follow a slightly different model than what you have written.

Consider:

procedure TSimpleThread.Execute;
begin
    if Assigned(FExecuteEvent) then
        FExecuteEvent(Self);
end;

Here when you run your thread it will execute this callback and then terminate. This doesn't seem to be what you want. What you seem to want is to keep the thread alive but waiting for its next work package. I use a base thread class (for pools) with an execute method that looks something like this (this is somewhat simplified):

procedure TMyCustomThread.Execute;
begin
  while not self.Terminated do begin
    try
      FGoEvent.WaitFor(INFINITE);
      FGoEvent.ResetEvent;
      if self.Terminated then break;
      MainExecute;        
    except
      HandleException;
    end;
  end;
end;

Here FGoEvent is a TEvent. The implementing class defines what the work package looks like in the abstract MainExecute method, but whatever it is the thread will perform its work and then return to waiting for the FGoEvent to signal that it has new work to do.

In your case, you need to keep track of which threads are waiting and which are working. You will probably want a manager class of some sort to keep track of these thread objects. Assigning something simple like a threadID to each one seems sensible. For each thread, just before launching it, make a record that it is currently busy. At the very end of your work package you can then post a message back to the manager class telling it that the work is done (and that it can flag the thread as available for work).

When you add work to the queue you can first check for available threads to run the work (or create a new one if you wish to follow the model you outlined). If there are threads then launch the task, if there are not then push the work onto the work queue. When worker threads report complete the manager can check the queue for outstanding work. If there is work it can immediately re-deploy the thread. If there isn't work it can flag the thread as available for work (here you might use a second queue for available workers).

A full implementation is too complex to document in a single answer here - this aims just to rough out some general ideas.

Upvotes: 2

Related Questions