线程池（2）

{
函 数 名：TThreadsPool.FreeFinishedThreads
功能描述：释放 FThreadsKilling 列表中的线程
输入参数：无
返 回 值: 无
创建日期：2006.10.22 11:34
修改日期：2006.
作 者：Kook
附加说明：
}

procedure TThreadsPool.FreeFinishedThreads;
var
i: Integer;
begin
if csThreadManagment.TryEnter then
try
for i := FThreadsKilling.Count - 1 downto 0 do
if TProcessorThread(FThreadsKilling[i]).isFinished then
begin
TProcessorThread(FThreadsKilling[i]).Free;
FThreadsKilling.Delete(i);
end;
finally
csThreadManagment.Leave
end;
end; { TThreadsPool.FreeFinishedThreads }

{
函 数 名：TThreadsPool.GetRequest
功能描述：申请任务
输入参数：out Request: TRequestDataObject
返 回 值: 无
创建日期：2006.10.22 11:34
修改日期：2006.
作 者：Kook
附加说明：
}

procedure TThreadsPool.GetRequest(out Request: TWorkItem);
begin
{$IFNDEF NOLOGS}
WriteLog('申请任务', 2);
{$ENDIF}
csQueueManagment.Enter;
try
//跳过空的队列元素
while (FLastGetPoint < FQueue.Count) and (FQueue[FLastGetPoint] = nil) do
Inc(FLastGetPoint);

Assert(FLastGetPoint < FQueue.Count);
//压缩队列，清除空元素
if (FQueue.Count > 127) and (FLastGetPoint >= (3 * FQueue.Count) div 4) then
begin
{$IFNDEF NOLOGS}
WriteLog('FQueue.Pack', 1);
{$ENDIF}
FQueue.Pack;
FLastGetPoint := 0;
end;

Request := TWorkItem(FQueue[FLastGetPoint]);
FQueue[FLastGetPoint] := nil;
inc(FLastGetPoint);
if (FLastGetPoint = FQueue.Count) then //如果队列中无任务
begin

DoQueueEmpty(ekQueueEmpty);
FQueue.Clear;
FLastGetPoint := 0;
end;
finally
csQueueManagment.Leave;
end;
end; { TThreadsPool.GetRequest }

function TThreadsPool.InfoText: string;
begin
Result := '';
//end;
//{$ELSE}
//var
// i: Integer;
//begin
// csQueueManagment.Enter;
// csThreadManagment.Enter;
// try
// if (FThreads.Count = 0) and (FThreadsKilling.Count = 1) and
// TProcessorThread(FThreadsKilling[0]).isFinished then
// FreeFinishedThreads;
//
// Result := Format(
// 'Pool thread: Min=%d, Max=%d, WorkingThreadsCount=%d, TerminatedThreadCount=%d, QueueLength=%d'#13#10,
// [ThreadsMin, ThreadsMax, FThreads.Count, FThreadsKilling.Count,
// FQueue.Count]
// );
// if FThreads.Count > 0 then
// Result := Result + 'Working threads:'#13#10;
// for i := 0 to FThreads.Count - 1 do
// Result := Result + TProcessorThread(FThreads[i]).InfoText + #13#10;
// if FThreadsKilling.Count > 0 then
// Result := Result + 'Terminated threads:'#13#10;
// for i := 0 to FThreadsKilling.Count - 1 do
// Result := Result + TProcessorThread(FThreadsKilling[i]).InfoText + #13#10;
// finally
// csThreadManagment.Leave;
// csQueueManagment.Leave;
// end;
//end;
//{$ENDIF}
end; { TThreadsPool.InfoText }

{
函 数 名：TThreadsPool.KillDeadThreads
功能描述：清除死线程
输入参数：无
返 回 值: 无
创建日期：2006.10.22 11:32
修改日期：2006.
作 者：Kook
附加说明：
}

procedure TThreadsPool.KillDeadThreads;
var
i: Integer;
begin
// Check for dead threads
if csThreadManagment.TryEnter then
try
for i := 0 to FThreads.Count - 1 do
if TProcessorThread(FThreads[i]).IsDead then
begin
// Dead thread moverd to other list.
// New thread created to replace dead one
TProcessorThread(FThreads[i]).Terminate;
FThreadsKilling.Add(FThreads[i]);
try
FThreads[i] := TProcessorThread.Create(Self);
except
on e: Exception do
begin
FThreads[i] := nil;
{$IFNDEF NOLOGS}
WriteLog(
'TProcessorThread.Create raise: ' + e.ClassName +
#13#10#9'Message: ' + e.Message,
9
);
{$ENDIF}
end;
end;
end;
finally
csThreadManagment.Leave
end;
end; { TThreadsPool.KillDeadThreads }

function TThreadsPool.PoolAverageWaitingTime: Integer;
var
i: Integer;
begin
Result := 0;
if FThreads.Count > 0 then
begin
for i := 0 to FThreads.Count - 1 do
Inc(result, TProcessorThread(FThreads[i]).AverageWaitingTime);
Result := Result div FThreads.Count
end
else
Result := 1;
end; { TThreadsPool.PoolAverageWaitingTime }

procedure TThreadsPool.WriteLog(const Str: string; Level: Integer = 0);
begin
{$IFNDEF NOLOGS}
uThreadPool.WriteLog(Str, 0, Level);
{$ENDIF}
end; { TThreadsPool.WriteLog }

// 工作线程仅用于线程池内， 不要直接创建并调用它。
{
******************************* TProcessorThread *******************************
}

constructor TProcessorThread.Create(APool: TThreadsPool);
begin
WriteLog('创建工作线程', 5);
inherited Create(True);
FPool := aPool;

FAverageWaitingTime := 1000;
FAverageProcessing := 3000;

sInitError := '';
{
各参数的意义如下：
　
参数一：填上 nil 即可。
参数二：是否采用手动调整灯号。
参数三：灯号的起始状态，False 表示红灯。
参数四：Event 名称, 对象名称相同的话，会指向同一个对象，所以想要有两个Event对象，便要有两个不同的名称(这名称以字符串来存.为NIL的话系统每次会自己创建一个不同的名字，就是被次创建的都是新的EVENT)。
传回值：Event handle。
}
hInitFinished := CreateEvent(nil, True, False, nil);
hThreadTerminated := CreateEvent(nil, True, False, nil);
csProcessingDataObject := TCriticalSection.Create;
try
WriteLog('TProcessorThread.Create::Resume', 3);
Resume;
//阻塞, 等待初始化完成
WaitForSingleObject(hInitFinished, INFINITE);
if sInitError <> '' then
raise Exception.Create(sInitError);
finally
CloseHandle(hInitFinished);
end;
WriteLog('TProcessorThread.Create::Finished', 3);
end; { TProcessorThread.Create }

destructor TProcessorThread.Destroy;
begin
WriteLog('工作线程销毁', 5);
CloseHandle(hThreadTerminated);
csProcessingDataObject.Free;
inherited;
end; { TProcessorThread.Destroy }

function TProcessorThread.AverageProcessingTime: DWORD;
begin
if (FCurState in [tcsProcessing]) then
Result := NewAverage(FAverageProcessing, GetTickCount - uProcessingStart)
else
Result := FAverageProcessing
end; { TProcessorThread.AverageProcessingTime }

function TProcessorThread.AverageWaitingTime: DWORD;
begin
if (FCurState in [tcsWaiting, tcsCheckingDown]) then
Result := NewAverage(FAverageWaitingTime, GetTickCount - uWaitingStart)
else
Result := FAverageWaitingTime
end; { TProcessorThread.AverageWaitingTime }

procedure TProcessorThread.Execute;

type
THandleID = (hidTerminateThread, hidRequest, hidCheckPoolDown);
var
WaitedTime: Integer;
Handles: array[THandleID] of THandle;

begin
WriteLog('工作线程进常运行', 3);
//当前状态：初始化
FCurState := tcsInitializing;
try
//执行外部事件
FPool.DoThreadInitializing(Self);
except
on e: Exception do
sInitError := e.Message;
end;

//初始化完成，初始化Event绿灯
SetEvent(hInitFinished);

WriteLog('TProcessorThread.Execute::Initialized', 3);

//引用线程池的同步 Event
Handles[hidTerminateThread] := hThreadTerminated;
Handles[hidRequest] := FPool.hSemRequestCount;
Handles[hidCheckPoolDown] := FPool.hTimCheckPoolDown;

//时间戳，
//todo: 好像在线程中用 GetTickCount; 会不正常
uWaitingStart := GetTickCount;
//任务置空
FProcessingDataObject := nil;

//大巡环
while not terminated do
begin
//当前状态：等待
FCurState := tcsWaiting;
//阻塞线程，使线程休眠
case WaitForMultipleObjects(Length(Handles), @Handles, False, INFINITE) -
WAIT_OBJECT_0 of

WAIT_OBJECT_0 + ord(hidTerminateThread):
begin
WriteLog('TProcessorThread.Execute:: Terminate event signaled ', 5);
//当前状态：正在终止线程
FCurState := tcsTerminating;
//退出大巡环(结束线程)
Break;
end;

WAIT_OBJECT_0 + ord(hidRequest):
begin
WriteLog('TProcessorThread.Execute:: Request semaphore signaled ', 3);
//等待的时间
WaitedTime := GetTickCount - uWaitingStart;
//重新计算平均等待时间
FAverageWaitingTime := NewAverage(FAverageWaitingTime, WaitedTime);
//当前状态：申请任务
FCurState := tcsGetting;
//如果等待时间过短，则检查工作线程是否足够
if WaitedTime < 5 then
FPool.CheckThreadsForGrow;
//从线程池的任务队列中得到任务
FPool.GetRequest(FProcessingDataObject);
//开始处理的时间戳
uProcessingStart := GetTickCount;
//当前状态：执行任务
FCurState := tcsProcessing;
try
{$IFNDEF NOLOGS}
WriteLog('Processing: ' + FProcessingDataObject.TextForLog, 2);
{$ENDIF}
//执行任务
FPool.DoProcessRequest(FProcessingDataObject, Self);
except
on e: Exception do
WriteLog(
'OnProcessRequest for ' + FProcessingDataObject.TextForLog +
#13#10'raise Exception: ' + e.Message,
8
);
end;

//释放任务对象
csProcessingDataObject.Enter;
try
FProcessingDataObject.Free;
FProcessingDataObject := nil;
finally
csProcessingDataObject.Leave;
end;
//重新计算
FAverageProcessing := NewAverage(FAverageProcessing, GetTickCount -
uProcessingStart);
//当前状态：执行任务完毕
FCurState := tcsProcessed;
//执行线程外事件
FPool.DoProcessed;

uWaitingStart := GetTickCount;
end;
WAIT_OBJECT_0 + ord(hidCheckPoolDown):
begin
// !!! Never called under Win9x
WriteLog('TProcessorThread.Execute:: CheckPoolDown timer signaled ',
4);
//当前状态：线程池停机（检查并清除空闲线程和死线程）
FCurState := tcsCheckingDown;
FPool.CheckPoolDown;
end;
end;
end;
FCurState := tcsTerminating;

FPool.DoThreadFinalizing(Self);
end; { TProcessorThread.Execute }

function TProcessorThread.IamCurrentlyProcess(DataObj: TWorkItem): Boolean;
begin
csProcessingDataObject.Enter;
try
Result := (FProcessingDataObject <> nil) and
DataObj.IsTheSame(FProcessingDataObject);
finally
csProcessingDataObject.Leave;
end;
end; { TProcessorThread.IamCurrentlyProcess }

function TProcessorThread.InfoText: string;

const
ThreadStateNames: array[TThreadState] of string =
(
'tcsInitializing',
'tcsWaiting',
'tcsGetting',
'tcsProcessing',
'tcsProcessed',
'tcsTerminating',
'tcsCheckingDown'
);

begin
{$IFNDEF NOLOGS}
Result := Format(
'%5d: %15s, AverageWaitingTime=%6d, AverageProcessingTime=%6d',
[ThreadID, ThreadStateNames[FCurState], AverageWaitingTime,
AverageProcessingTime]
);
case FCurState of
tcsWaiting:
Result := Result + ', WaitingTime=' + IntToStr(GetTickCount -
uWaitingStart);
tcsProcessing:
Result := Result + ', ProcessingTime=' + IntToStr(GetTickCount -
uProcessingStart);
end;

csProcessingDataObject.Enter;
try
if FProcessingDataObject <> nil then
Result := Result + ' ' + FProcessingDataObject.TextForLog;
finally
csProcessingDataObject.Leave;
end;
{$ENDIF}
end; { TProcessorThread.InfoText }

function TProcessorThread.IsDead: Boolean;
begin
Result :=
Terminated or
(FPool.ThreadDeadTimeout > 0) and (FCurState = tcsProcessing) and
(GetTickCount - uProcessingStart > FPool.ThreadDeadTimeout);
if Result then
WriteLog('Thread dead', 5);
end; { TProcessorThread.IsDead }

function TProcessorThread.isFinished: Boolean;
begin
Result := WaitForSingleObject(Handle, 0) = WAIT_OBJECT_0;
end; { TProcessorThread.isFinished }

function TProcessorThread.isIdle: Boolean;
begin
// 如果线程状态是 tcsWaiting, tcsCheckingDown
// 并且 空间时间 > 100ms,
// 并且 平均等候任务时间大于平均工作时间的 50%
// 则视为空闲。
Result :=
(FCurState in [tcsWaiting, tcsCheckingDown]) and
(AverageWaitingTime > 100) and
(AverageWaitingTime * 2 > AverageProcessingTime);
end; { TProcessorThread.isIdle }

function TProcessorThread.NewAverage(OldAvg, NewVal: Integer): Integer;
begin
Result := (OldAvg * 2 + NewVal) div 3;
end; { TProcessorThread.NewAverage }

procedure TProcessorThread.Terminate;
begin
WriteLog('TProcessorThread.Terminate', 5);
inherited Terminate;
SetEvent(hThreadTerminated);
end; { TProcessorThread.Terminate }

procedure TProcessorThread.WriteLog(const Str: string; Level: Integer = 0);
begin
{$IFNDEF NOLOGS}
uThreadPool.WriteLog(Str, ThreadID, Level);
{$ENDIF}
end; { TProcessorThread.WriteLog }

{
******************************* TCriticalSection *******************************
}

constructor TCriticalSection.Create;
begin
InitializeCriticalSection(FSection);
end; { TCriticalSection.Create }

destructor TCriticalSection.Destroy;
begin
DeleteCriticalSection(FSection);
end; { TCriticalSection.Destroy }

procedure TCriticalSection.Enter;
begin
EnterCriticalSection(FSection);
end; { TCriticalSection.Enter }

procedure TCriticalSection.Leave;
begin
LeaveCriticalSection(FSection);
end; { TCriticalSection.Leave }

function TCriticalSection.TryEnter: Boolean;
begin
Result := TryEnterCriticalSection(FSection);
end; { TCriticalSection.TryEnter }

procedure NoLogs(const Str: string; LogID: Integer = 0; Level: Integer = 0);
begin
end;

initialization
WriteLog := NoLogs;
end.