kam-mobile/vendor/kam_remake/src/common/KM_WorkerThread.pas

unit KM_WorkerThread;
{$I KaM_Remake.inc}
interface
uses
  Classes, SysUtils, Generics.Collections;

type
  // FPC 3.2.2 still has problems with TProc and TProc<>
  // Hence the simplest solution is to excelude this utility unit from DedicatedServer projects
  {$IFDEF WDC}
  TKMWorkerThreadTask = class
  public
    TaskName: string;
    Proc: TProc;
    OnDone: TProc<String>;
  end;
  {$ENDIF}

  TKMWorkerThread = class(TThread)
  // FPC 3.2.2 still has problems with TProc and TProc<>
  // Hence the simplest solution is to excelude this utility unit from DedicatedServer projects
  {$IFDEF WDC}
  private
    fWorkerThreadName: string;
    fWorkCompleted: Boolean;
    fTaskQueue: TQueue<TKMWorkerThreadTask>;

    procedure NameThread; overload;
    procedure NameThread(aThreadName: string); overload;
    function GetBaseThreadName: string;
  public
    //Special mode for exception handling. Runs work synchronously inside QueueWork
    fSynchronousExceptionMode: Boolean;

    constructor Create(const aThreadName: string = '');
    destructor Destroy; override;
    procedure Execute; override;

    procedure QueueWork(aProc: TProc; aTaskName: string = '');
    // It is a bit odd that we want the callback to return the aTaskName
    procedure QueueWorkAndCallback(aProc: TProc; aOnDone: TProc<String> = nil; aTaskName: string = '');
    procedure QueueWorkAndLog(aProc: TProc; aTaskName: string = '');

    procedure WaitForAllWorkToComplete;
  {$ENDIF}
  end;


  // Holder of WorkerThread
  // It should manage its state and recreate an instance if needed
  TKMWorkerThreadHolder = class
  {$IFDEF WDC}
  private
    fWorkerThreadName: string;
    fWorkerThread: TKMWorkerThread;
    function GetWorkerThread: TKMWorkerThread;
  public
    constructor Create(const aThreadName: String);
    destructor Destroy; override;

    property Worker: TKMWorkerThread read GetWorkerThread write fWorkerThread;
  {$ENDIF}
  end;


implementation
uses
  KM_Log;


{$IFDEF WDC}
{ TKMWorkerThread }
constructor TKMWorkerThread.Create(const aThreadName: string = '');
begin
  //Thread isn't started until all constructors have run to completion
  //so Create(False) may be put in front as well
  inherited Create(False);

  fWorkerThreadName := aThreadName;

  {$IFDEF DEBUG}
  if fWorkerThreadName <> '' then
    TThread.NameThreadForDebugging(fWorkerThreadName, ThreadID);
  {$ENDIF}

  fWorkCompleted := False;
  fSynchronousExceptionMode := False;
  fTaskQueue := TQueue<TKMWorkerThreadTask>.Create;
end;

destructor TKMWorkerThread.Destroy;
begin
  Terminate;
  //Wake the thread if it's waiting
  TMonitor.Enter(fTaskQueue);
  try
    TMonitor.Pulse(fTaskQueue);
  finally
    TMonitor.Exit(fTaskQueue);
  end;

  inherited Destroy;

  fTaskQueue.Free; // Free task queue after Worker thread is destroyed so we don't wait for it
end;


function TKMWorkerThread.GetBaseThreadName: string;
begin
  {$IFDEF DEBUG}
  Result := fWorkerThreadName + ' Jobs=' + IntToStr(fTaskQueue.Count); // Has to be synced!
  {$ELSE}
  Result := '';
  {$ENDIF}
end;


procedure TKMWorkerThread.NameThread;
begin
  {$IFDEF DEBUG}
  NameThread(fWorkerThreadName);
  {$ENDIF}
end;


procedure TKMWorkerThread.NameThread(aThreadName: string);
begin
  {$IFDEF DEBUG}
  if fWorkerThreadName <> '' then
    TThread.NameThreadForDebugging(aThreadName);
  {$ENDIF}
end;


procedure TKMWorkerThread.Execute;
var
  task: TKMWorkerThreadTask;
  loopRunning: Boolean;
  threadName: string;
begin
  task := nil;
  loopRunning := True;
  threadName := '';

  while loopRunning do
  begin
    TMonitor.Enter(fTaskQueue);
    try
      threadName := GetBaseThreadName; // get name under TMonitor, cause we access fTaskQueue
      if fTaskQueue.Count > 0 then
      begin
        task := fTaskQueue.Dequeue;
      end
      else
      begin
        //We may only terminate once we have finished all our work
        if Terminated then
        begin
          loopRunning := False;
        end
        else
        begin
          //Notify main thread that worker is idle if it's blocked in WaitForAllWorkToComplete
          fWorkCompleted := True;
          TMonitor.Pulse(fTaskQueue);

          TMonitor.Wait(fTaskQueue, 10000);
          if fTaskQueue.Count > 0 then
            task := fTaskQueue.Dequeue;
        end;
      end;
    finally
      TMonitor.Exit(fTaskQueue);
    end;

    if task <> nil then
    begin
      NameThread(threadName);
      task.Proc();

      if Assigned(task.OnDone) then
        task.OnDone(task.TaskName);

      FreeAndNil(task);
    end;

    NameThread;
  end;
end;


procedure TKMWorkerThread.QueueWorkAndLog(aProc: TProc; aTaskName: string = '');
begin
  QueueWorkAndCallback(
    aProc,
    // aOnDone (aTaskNameInt = aTaskName, we just use a different name to avoid sideeffects)
    procedure(aTaskNameInt: String)
    begin
      gLog.AddTime('Job "%s" is completed', [aTaskNameInt]);
    end,
    aTaskName);
end;


procedure TKMWorkerThread.QueueWork(aProc: TProc; aTaskName: string = '');
begin
  QueueWorkAndCallback(aProc, nil, aTaskName);
end;


procedure TKMWorkerThread.QueueWorkAndCallback(aProc: TProc; aOnDone: TProc<String> = nil; aTaskName: string = '');
var
  task: TKMWorkerThreadTask;
begin
  if fSynchronousExceptionMode then
  begin
    aProc();
  end
  else
  begin
    if Finished then
      raise Exception.Create('Worker thread not running in TKMWorkerThread.QueueWork');

    task := TKMWorkerThreadTask.Create;
    task.Proc := aProc;
    task.OnDone := aOnDone;
    task.TaskName := aTaskName;

    TMonitor.Enter(fTaskQueue);
    try
      fWorkCompleted := False;
      fTaskQueue.Enqueue(task);

      TMonitor.Pulse(fTaskQueue);
    finally
      TMonitor.Exit(fTaskQueue);
    end;
  end;
end;


procedure TKMWorkerThread.WaitForAllWorkToComplete;
begin
  if fSynchronousExceptionMode then
    Exit;

  TMonitor.Enter(fTaskQueue);
  try
    if not fWorkCompleted and not Finished then
    begin
      //Wait infinite until worker thread finish his task
      while not TMonitor.Wait(fTaskQueue, 1000) do ;
    end;
  finally
    TMonitor.Exit(fTaskQueue);
  end;
end;


{ TKMWorkerThreadHolder }
constructor TKMWorkerThreadHolder.Create(const aThreadName: String);
begin
  inherited Create;

  fWorkerThreadName := aThreadName;
end;


destructor TKMWorkerThreadHolder.Destroy;
begin
  FreeAndNil(fWorkerThread);

  inherited;
end;


// Get working thread instance
// Working thread could be Finished, f.e. in case of an error during its execution
// Thread is not running in that case after Continue is pressed in madexcept window and has Finished flag
// We can call old thread destructor via Free-ing it and then recreate new worker thread.
function TKMWorkerThreadHolder.GetWorkerThread: TKMWorkerThread;
begin
  if (fWorkerThread = nil) then
    // Create new thread
    fWorkerThread := TKMWorkerThread.Create(fWorkerThreadName)
  else
  if fWorkerThread.Finished then
  begin
    // Call destructor of an old thread
    fWorkerThread.Free;
    // Create new one instead
    fWorkerThread := TKMWorkerThread.Create(fWorkerThreadName);
  end;

  Result := fWorkerThread;
end;
{$ENDIF}


end.