sync: restore source from Google Drive

vendor/kam_remake/src/common/KM_WorkerThread.pas

@@ -0,0 +1,301 @@
+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.
+