TThreadPool AV, multi thread beginner here.

So I ran into my first chance to attempt to fully use all the cores of a system. Basically my application needs to test 12 different compression schemes and select the best one. I realized that I could use a thread per core because there was no I/O to the HD so this should be perfect.

I decided that a ThreadPool would be useful after reading about it because the number of tasks can vary from 6 to 12. I was looking around torry.net and found two examples but they were either too complicated or I just plain couldn't understand them.

So I decided to make my own simple class where: You create it, define the number of threads to use, and can call AddTask() to add a TThreadFunc to the queue. When first trying it I stepped through the code to make sure everything was proceeding smoothly. It seemed like it was until I decided to press run and got some A/V's. They belonged to ntdll.dll at EnterCriticalSection.

Being my first attempt at this I know I'm probably doing this inefficiently and would like some help from someone more knowledgeable on Threads/CriticalSections/etc.

unit ThreadPool;
 
interface
 
uses
  Windows,
  Classes;
 
type
  THandleList = Array of DWORD;
  PThreadTask = ^TThreadTask;
  TThreadTask = record
    Data: Pointer;
    ThreadProc: Pointer;
    AppointedThread: DWORD;
  end;
  PThreadPool = ^TThreadPool;
  TThreadPool = class
    private
      fCurrentThreadCount: Byte;
      fNumberOfThreads: Byte;
      fNumberOfTasks: DWORD;
      fThreadHandles: THandleList;
      fQueue: TThreadList;
      fQueueFilled: Boolean;
      procedure SyncronizeTasks;
    public
      property NumberOfThreads: Byte read fNumberOfThreads;
      property NumberOfTasks: DWORD read fNumberOfTasks;
      property ThreadHandles: THandleList read fThreadHandles;
      property QueueFilled: Boolean read fQueueFilled write fQueueFilled;
      constructor Create(NumberOfThreads: Byte);
      destructor Destroy; override;
      procedure AddTask(const ThreadProc: Pointer; Parameter: Pointer);
  end;
 
implementation
 
constructor TThreadPool.Create(NumberOfThreads: Byte);
begin
  inherited Create;
  If NumberOfThreads < 1 Then NumberOfThreads := 1;
  fNumberOfThreads := NumberOfThreads;
  SetLength(fThreadHandles,fNumberOfThreads);
  fQueue := TThreadList.Create;
  fQueue.Duplicates := dupAccept;
  fCurrentThreadCount := 0;
  fQueueFilled := True;
  fNumberOfTasks := 0;
end;
 
destructor TThreadPool.Destroy;
var
  I : Integer;
begin
  For I := Low(fThreadHandles) To High(fThreadHandles) Do
    begin
    TerminateThread(fThreadHandles[I],0);
  end;
  fQueue.Free;
  inherited Destroy;
end;
 
procedure TThreadPool.AddTask(const ThreadProc: Pointer; Parameter: Pointer);
var
  ThreadTask : PThreadTask;
begin
  If ThreadProc = nil Then Exit;
  ThreadTask := AllocMem(SizeOf(TThreadTask));
  ThreadTask^.Data := Parameter;
  ThreadTask^.ThreadProc := ThreadProc;
  fQueue.Add(ThreadTask);
  Inc(fNumberOfTasks);
  SyncronizeTasks;
end;
 
function ThreadPoolThread(Data: Pointer): DWORD;
var
  ExitCode : DWORD;
  ThreadPool : TThreadPool;
  CurTask : TThreadTask;
  ThreadFunc : TThreadFunc;
begin
  ThreadPool := PThreadPool(Data)^;
  GetExitCodeThread(GetCurrentThread,ExitCode);
  While ExitCode = STILL_ACTIVE Do
    begin
    With ThreadPool.fQueue.LockList Do
      begin
      Try
        If (Count = 0) And (ThreadPool.fQueueFilled) Then
          begin
          Break;
        end
        Else
          begin
          Sleep(100);
        end;
        CurTask := PThreadTask(Items[0])^;
        If CurTask.AppointedThread <> 0 Then
          begin
          Delete(0);
          Dec(ThreadPool.fNumberOfTasks);
        end
        Else
          begin
          CurTask.AppointedThread := GetCurrentThread;
          ThreadFunc := CurTask.ThreadProc;
          ThreadFunc(CurTask.Data);
          CurTask.AppointedThread := 0;
        end;
      Finally
        ThreadPool.fQueue.UnlockList;
      end;
    end;
  end;
  Result := 0;
end;
 
procedure TThreadPool.SyncronizeTasks;
var
  ThreadID : DWORD;
begin
  If (fNumberOfTasks > fCurrentThreadCount) And (fCurrentThreadCount < fNumberOfThreads) Then
    begin
    fThreadHandles[fCurrentThreadCount] := BeginThread(nil,0,@ThreadPoolThread,@Self,0,ThreadID);
    Inc(fCurrentThreadCount);
  end;
end;
 
end.

Select allOpen in new window