xtool/contrib/CoreCipher/Source/CoreComputeThread.inc

506 lines
14 KiB
PHP

{ ****************************************************************************** }
{ * https://zpascal.net * }
{ * https://github.com/PassByYou888/zAI * }
{ * https://github.com/PassByYou888/ZServer4D * }
{ * https://github.com/PassByYou888/PascalString * }
{ * https://github.com/PassByYou888/zRasterization * }
{ * https://github.com/PassByYou888/CoreCipher * }
{ * https://github.com/PassByYou888/zSound * }
{ * https://github.com/PassByYou888/zChinese * }
{ * https://github.com/PassByYou888/zExpression * }
{ * https://github.com/PassByYou888/zGameWare * }
{ * https://github.com/PassByYou888/zAnalysis * }
{ * https://github.com/PassByYou888/FFMPEG-Header * }
{ * https://github.com/PassByYou888/zTranslate * }
{ * https://github.com/PassByYou888/InfiniteIoT * }
{ * https://github.com/PassByYou888/FastMD5 * }
{ ****************************************************************************** }
type
TComputeDispatch = record
OnRunCall: TRunWithThreadCall;
OnRunMethod: TRunWithThreadMethod;
OnRunProc: TRunWithThreadProc;
OnRunCall_NP: TRunWithThreadCall_NP;
OnRunMethod_NP: TRunWithThreadMethod_NP;
OnRunProc_NP: TRunWithThreadProc_NP;
OnDoneCall: TRunWithThreadCall;
OnDoneMethod: TRunWithThreadMethod;
OnDoneProc: TRunWithThreadProc;
UserData: Pointer;
UserObject: TCoreClassObject;
procedure Init;
procedure AssignTo(th: TComputeThread);
end;
PComputeDispatchData = ^TComputeDispatch;
TCoreComputeThreadPool = {$IFDEF FPC}specialize {$ENDIF FPC} TGenericsList<TComputeThread>;
TComputeDispatchPool = {$IFDEF FPC}specialize {$ENDIF FPC} TGenericsList<PComputeDispatchData>;
TParallelOverflow = record
ActivtedParallel: Integer;
procedure Acquire;
procedure Release;
function Busy(): Boolean; inline;
end;
var
CoreThreadPool: TCoreComputeThreadPool;
ComputeDispatchCritical: TCritical;
ComputeThreadTaskRunning: TAtomInteger;
ParallelGranularity: Integer;
MaxActivtedParallel: Integer;
ParallelOverflow: TParallelOverflow;
ComputeDispatchPool: TComputeDispatchPool;
IdleComputeThreadSum: TAtomInt;
procedure TComputeDispatch.Init;
begin
OnRunCall := nil;
OnRunMethod := nil;
OnRunProc := nil;
OnRunCall_NP := nil;
OnRunMethod_NP := nil;
OnRunProc_NP := nil;
OnDoneCall := nil;
OnDoneMethod := nil;
OnDoneProc := nil;
UserData := nil;
UserObject := nil;
end;
procedure TComputeDispatch.AssignTo(th: TComputeThread);
begin
th.OnRunCall := OnRunCall;
th.OnRunMethod := OnRunMethod;
th.OnRunProc := OnRunProc;
th.OnRunCall_NP := OnRunCall_NP;
th.OnRunMethod_NP := OnRunMethod_NP;
th.OnRunProc_NP := OnRunProc_NP;
th.OnDoneCall := OnDoneCall;
th.OnDoneMethod := OnDoneMethod;
th.OnDoneProc := OnDoneProc;
th.UserData := UserData;
th.UserObject := UserObject;
end;
procedure TParallelOverflow.Acquire;
begin
while Busy() do
TCoreClassThread.Sleep(1);
AtomInc(ActivtedParallel);
end;
procedure TParallelOverflow.Release;
begin
AtomDec(ActivtedParallel);
end;
function TParallelOverflow.Busy(): Boolean;
begin
Result := ActivtedParallel >= MaxActivtedParallel;
end;
function PickOrCreateThread(): TComputeThread;
begin
Result := TComputeThread.Create;
CoreThreadPool.Add(Result);
end;
procedure PostComputeDispatchData(var data: TComputeDispatch);
var
tk: TTimeTick;
done: Boolean;
th: TComputeThread;
begin
// check for idle thread, and again run.
if IdleComputeThreadSum.V > 0 then
begin
ComputeDispatchCritical.Acquire;
ComputeDispatchPool.Add(@data);
ComputeDispatchCritical.Release;
tk := GetTimeTick();
while (IdleComputeThreadSum.V > 0) and (GetTimeTick() - tk < 20) do
begin
ComputeDispatchCritical.Acquire;
done := ComputeDispatchPool.IndexOf(@data) < 0;
ComputeDispatchCritical.Release;
if done then
exit;
end;
ComputeDispatchCritical.Acquire;
done := ComputeDispatchPool.IndexOf(@data) < 0;
if not done then
ComputeDispatchPool.Remove(@data);
ComputeDispatchCritical.Release;
if done then
exit;
end;
// create thread
ComputeDispatchCritical.Acquire;
inc(ComputeThreadTaskRunning.LockP()^);
ComputeThreadTaskRunning.Unlock;
th := PickOrCreateThread();
data.AssignTo(th);
th.Start();
ComputeDispatchCritical.Release;
end;
procedure InitCoreThreadPool(Thread_Num: Integer);
var
th: TComputeThread;
begin
CoreThreadPool := TCoreComputeThreadPool.Create;
ComputeThreadTaskRunning := TAtomInteger.Create(0);
ParallelGranularity := Thread_Num;
ComputeDispatchCritical := TCritical.Create;
MaxActivtedParallel := Thread_Num;
ParallelOverflow.ActivtedParallel := 0;
ComputeDispatchPool := TComputeDispatchPool.Create;
IdleComputeThreadSum := TAtomInt.Create(0);
end;
procedure FreeCoreThreadPool;
begin
while TComputeThread.ActivtedTask() > 0 do
CheckThreadSynchronize(1);
CoreThreadPool.Free;
CoreThreadPool := nil;
ComputeThreadTaskRunning.Free;
ComputeThreadTaskRunning := nil;
ComputeDispatchCritical.Free;
ComputeDispatchCritical := nil;
ComputeDispatchPool.Free;
ComputeDispatchPool := nil;
IdleComputeThreadSum.Free;
IdleComputeThreadSum := nil;
end;
procedure TComputeThread.Execute;
var
tk: TTimeTick;
NoTask: Boolean;
i: Integer;
begin
while True do
begin
try
{$IFDEF MT19937SeedOnTComputeThreadIs0} SetMT19937Seed(0); {$ELSE MT19937SeedOnTComputeThreadIs0} MT19937Randomize(); {$ENDIF MT19937SeedOnTComputeThreadIs0}
if Assigned(OnRunCall) then
OnRunCall(Self);
if Assigned(OnRunMethod) then
OnRunMethod(Self);
if Assigned(OnRunProc) then
OnRunProc(Self);
if Assigned(OnRunCall_NP) then
OnRunCall_NP();
if Assigned(OnRunMethod_NP) then
OnRunMethod_NP();
if Assigned(OnRunProc_NP) then
OnRunProc_NP();
except
end;
if Assigned(OnDoneCall) or Assigned(OnDoneMethod) or Assigned(OnDoneProc) then
Synchronize({$IFDEF FPC}@{$ENDIF FPC}Done_Sync);
// check for idle thread, and again run.
tk := GetTimeTick;
NoTask := True;
inc(IdleComputeThreadSum.LockP^);
IdleComputeThreadSum.Unlock;
for i := 1 to 100 do
begin
while NoTask and (GetTimeTick - tk < 10) do
begin
ComputeDispatchCritical.Acquire;
if ComputeDispatchPool.Count > 0 then
begin
ComputeDispatchPool[0]^.AssignTo(Self);
ComputeDispatchPool.Delete(0);
NoTask := False;
end;
ComputeDispatchCritical.Release;
end;
if not NoTask then
break;
// little delay
Sleep(1);
end;
dec(IdleComputeThreadSum.LockP^);
IdleComputeThreadSum.Unlock;
if NoTask then
break;
end;
dec(ComputeThreadTaskRunning.LockP()^);
ComputeThreadTaskRunning.Unlock();
ComputeDispatchCritical.Acquire;
CoreThreadPool.Remove(Self);
ComputeDispatchCritical.Release;
RemoveMT19937Thread(Self);
end;
procedure TComputeThread.Done_Sync;
begin
try
if Assigned(OnDoneCall) then
OnDoneCall(Self);
if Assigned(OnDoneMethod) then
OnDoneMethod(Self);
if Assigned(OnDoneProc) then
OnDoneProc(Self);
except
end;
end;
constructor TComputeThread.Create;
begin
inherited Create(True);
FreeOnTerminate := True;
OnRunCall := nil;
OnRunMethod := nil;
OnRunProc := nil;
OnRunCall_NP := nil;
OnRunMethod_NP := nil;
OnRunProc_NP := nil;
OnDoneCall := nil;
OnDoneMethod := nil;
OnDoneProc := nil;
UserData := nil;
UserObject := nil;
end;
destructor TComputeThread.Destroy;
begin
inherited Destroy;
end;
class function TComputeThread.ActivtedTask(): Integer;
begin
ComputeDispatchCritical.Acquire;
Result := CoreThreadPool.Count;
ComputeDispatchCritical.Release;
end;
class function TComputeThread.WaitTask(): Integer;
begin
Result := IdleComputeThreadSum.V;
end;
class function TComputeThread.TotalTask(): Integer;
begin
Result := ComputeThreadTaskRunning.V;
end;
class function TComputeThread.State(): string;
begin
Result := Format('total: %d Activted: %d Waiting: %d Granularity: %d MaxParallel: %d/%d',
[TotalTask(), ActivtedTask(), WaitTask(), ParallelGranularity, ParallelOverflow.ActivtedParallel, MaxActivtedParallel]);
end;
class function TComputeThread.GetParallelGranularity: Integer;
begin
Result := ParallelGranularity;
end;
class function TComputeThread.GetMaxActivtedParallel: Integer;
begin
Result := MaxActivtedParallel;
end;
type
TSyncTmp = class
private
OnRun: TRunWithThreadProc_NP;
procedure DoSync;
end;
procedure TSyncTmp.DoSync;
begin
try
OnRun();
Free;
except
end;
end;
class procedure TComputeThread.Sync(const OnRun_: TRunWithThreadProc_NP);
{$IFDEF FPC}
var
tmp: TSyncTmp;
{$ENDIF FPC}
begin
{$IFDEF FPC}
tmp := TSyncTmp.Create;
tmp.OnRun := OnRun_;
TCompute.Synchronize(TCompute.CurrentThread, @tmp.DoSync);
{$ELSE FPC}
TCompute.Synchronize(TCompute.CurrentThread, procedure
begin
OnRun_();
end);
{$ENDIF FPC}
end;
class procedure TComputeThread.Sync(const Thread_: TThread; OnRun_: TRunWithThreadProc_NP);
{$IFDEF FPC}
var
tmp: TSyncTmp;
{$ENDIF FPC}
begin
{$IFDEF FPC}
tmp := TSyncTmp.Create;
tmp.OnRun := OnRun_;
TCompute.Synchronize(Thread_, @tmp.DoSync);
{$ELSE FPC}
TCompute.Synchronize(Thread_, procedure
begin
OnRun_();
end);
{$ENDIF FPC}
end;
class procedure TComputeThread.RunC(const data: Pointer; const Obj: TCoreClassObject; const OnRun, OnDone: TRunWithThreadCall);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunCall := OnRun;
Dispatch_.OnDoneCall := OnDone;
Dispatch_.UserData := data;
Dispatch_.UserObject := Obj;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunC(const data: Pointer; const Obj: TCoreClassObject; const OnRun: TRunWithThreadCall);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunCall := OnRun;
Dispatch_.UserData := data;
Dispatch_.UserObject := Obj;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunC(const OnRun: TRunWithThreadCall);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunCall := OnRun;
Dispatch_.UserData := nil;
Dispatch_.UserObject := nil;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunC_NP(const OnRun: TRunWithThreadCall_NP);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunCall_NP := OnRun;
Dispatch_.UserData := nil;
Dispatch_.UserObject := nil;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunM(const data: Pointer; const Obj: TCoreClassObject; const OnRun, OnDone: TRunWithThreadMethod);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunMethod := OnRun;
Dispatch_.OnDoneMethod := OnDone;
Dispatch_.UserData := data;
Dispatch_.UserObject := Obj;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunM(const data: Pointer; const Obj: TCoreClassObject; const OnRun: TRunWithThreadMethod);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunMethod := OnRun;
Dispatch_.UserData := data;
Dispatch_.UserObject := Obj;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunM(const OnRun: TRunWithThreadMethod);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunMethod := OnRun;
Dispatch_.UserData := nil;
Dispatch_.UserObject := nil;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunM_NP(const OnRun: TRunWithThreadMethod_NP);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunMethod_NP := OnRun;
Dispatch_.UserData := nil;
Dispatch_.UserObject := nil;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunP(const data: Pointer; const Obj: TCoreClassObject; const OnRun, OnDone: TRunWithThreadProc);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunProc := OnRun;
Dispatch_.OnDoneProc := OnDone;
Dispatch_.UserData := data;
Dispatch_.UserObject := Obj;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunP(const data: Pointer; const Obj: TCoreClassObject; const OnRun: TRunWithThreadProc);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunProc := OnRun;
Dispatch_.UserData := data;
Dispatch_.UserObject := Obj;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunP(const OnRun: TRunWithThreadProc);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunProc := OnRun;
Dispatch_.UserData := nil;
Dispatch_.UserObject := nil;
PostComputeDispatchData(Dispatch_);
end;
class procedure TComputeThread.RunP_NP(const OnRun: TRunWithThreadProc_NP);
var
Dispatch_: TComputeDispatch;
begin
Dispatch_.Init;
Dispatch_.OnRunProc_NP := OnRun;
Dispatch_.UserData := nil;
Dispatch_.UserObject := nil;
PostComputeDispatchData(Dispatch_);
end;