265 lines
7.1 KiB
Plaintext
265 lines
7.1 KiB
Plaintext
{
|
|
$Project$
|
|
$Workfile$
|
|
$Revision$
|
|
$DateUTC$
|
|
$Id$
|
|
|
|
This file is part of the Indy (Internet Direct) project, and is offered
|
|
under the dual-licensing agreement described on the Indy website.
|
|
(http://www.indyproject.org/)
|
|
|
|
Copyright:
|
|
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
|
|
}
|
|
{
|
|
$Log$
|
|
}
|
|
{
|
|
Rev 1.32 3/23/2005 8:20:18 AM JPMugaas
|
|
Temp fix for a double-free problem causing an AV. I will explain on Core.
|
|
|
|
Rev 1.31 6/11/2004 8:48:32 AM DSiders
|
|
Added "Do not Localize" comments.
|
|
|
|
Rev 1.30 2004.03.01 5:12:38 PM czhower
|
|
-Bug fix for shutdown of servers when connections still existed (AV)
|
|
-Implicit HELP support in CMDserver
|
|
-Several command handler bugs
|
|
-Additional command handler functionality.
|
|
|
|
Rev 1.29 2004.02.03 4:17:04 PM czhower
|
|
For unit name changes.
|
|
|
|
Rev 1.28 2004.01.22 5:59:14 PM czhower
|
|
IdCriticalSection
|
|
|
|
Rev 1.27 2004.01.20 10:03:32 PM czhower
|
|
InitComponent
|
|
|
|
Rev 1.26 6/11/2003 8:28:42 PM GGrieve
|
|
remove wrong call to inherited StartYarn
|
|
|
|
Rev 1.25 2003.10.24 12:59:18 PM czhower
|
|
Name change
|
|
|
|
Rev 1.24 2003.10.21 12:19:00 AM czhower
|
|
TIdTask support and fiber bug fixes.
|
|
|
|
Rev 1.23 10/15/2003 8:35:30 PM DSiders
|
|
Added resource string for exception raised in TIdSchedulerOfThread.NewYarn.
|
|
|
|
Rev 1.22 2003.10.14 11:18:10 PM czhower
|
|
Fix for AV on shutdown and other bugs
|
|
|
|
Rev 1.21 2003.10.11 5:49:32 PM czhower
|
|
-VCL fixes for servers
|
|
-Chain suport for servers (Super core)
|
|
-Scheduler upgrades
|
|
-Full yarn support
|
|
|
|
Rev 1.20 2003.09.19 10:11:18 PM czhower
|
|
Next stage of fiber support in servers.
|
|
|
|
Rev 1.19 2003.09.19 11:54:30 AM czhower
|
|
-Completed more features necessary for servers
|
|
-Fixed some bugs
|
|
|
|
Rev 1.18 2003.09.18 4:43:18 PM czhower
|
|
-Removed IdBaseThread
|
|
-Threads now have default names
|
|
|
|
Rev 1.17 2003.09.18 4:10:26 PM czhower
|
|
Preliminary changes for Yarn support.
|
|
|
|
Rev 1.16 2003.07.17 1:08:04 PM czhower
|
|
Fixed warning
|
|
|
|
Rev 1.15 7/6/2003 8:04:06 PM BGooijen
|
|
Renamed IdScheduler* to IdSchedulerOf*
|
|
|
|
Rev 1.14 7/5/2003 11:49:06 PM BGooijen
|
|
Cleaned up and fixed av in threadpool
|
|
|
|
Rev 1.13 2003.06.30 9:39:44 PM czhower
|
|
Comments and small change.
|
|
|
|
Rev 1.12 6/25/2003 3:54:02 PM BGooijen
|
|
Destructor waits now until all threads are terminated
|
|
|
|
Rev 1.11 2003.06.25 4:27:02 PM czhower
|
|
Fixed some formatting and fixed one line ifs.
|
|
|
|
Rev 1.10 4/11/2003 6:35:28 PM BGooijen
|
|
|
|
Rev 1.9 3/27/2003 5:17:22 PM BGooijen
|
|
Moved some code to TIdScheduler, made ThreadPriority published
|
|
|
|
Rev 1.8 3/22/2003 1:49:38 PM BGooijen
|
|
Fixed warnings (.ShouldStop)
|
|
|
|
Rev 1.7 3/13/2003 10:18:30 AM BGooijen
|
|
Server side fibers, bug fixes
|
|
|
|
Rev 1.6 1/23/2003 11:55:24 PM BGooijen
|
|
|
|
Rev 1.5 1/23/2003 8:32:40 PM BGooijen
|
|
Added termination handler
|
|
|
|
Rev 1.3 1/23/2003 11:05:58 AM BGooijen
|
|
|
|
Rev 1.2 1-17-2003 23:22:16 BGooijen
|
|
added MaxThreads property
|
|
|
|
Rev 1.1 1/17/2003 03:43:04 PM JPMugaas
|
|
Updated to use new class.
|
|
|
|
Rev 1.0 1/17/2003 03:29:50 PM JPMugaas
|
|
Renamed from ThreadMgr for new design.
|
|
|
|
Rev 1.0 11/13/2002 09:01:32 AM JPMugaas
|
|
|
|
02 Oct 2001 - Allen O'Neill
|
|
Added support for thread priority - new property Threadpriority,
|
|
new line added to OnCreate
|
|
}
|
|
|
|
unit IdSchedulerOfThread;
|
|
|
|
interface
|
|
{$i IdCompilerDefines.inc}
|
|
|
|
uses
|
|
Classes,
|
|
IdException, IdBaseComponent, IdGlobal, IdScheduler,
|
|
IdThread, IdTask, IdYarn;
|
|
|
|
type
|
|
TIdYarnOfThread = class(TIdYarn)
|
|
protected
|
|
// TODO: should these be [Weak] on ARC systems?
|
|
FScheduler: TIdScheduler;
|
|
FThread: TIdThreadWithTask;
|
|
public
|
|
constructor Create(AScheduler: TIdScheduler; AThread: TIdThreadWithTask); reintroduce;
|
|
destructor Destroy; override;
|
|
//
|
|
property Thread: TIdThreadWithTask read FThread;
|
|
end;
|
|
|
|
TIdSchedulerOfThread = class(TIdScheduler)
|
|
protected
|
|
FMaxThreads: Integer;
|
|
FThreadPriority: TIdThreadPriority;
|
|
FThreadClass: TIdThreadWithTaskClass;
|
|
//
|
|
procedure InitComponent; override;
|
|
public
|
|
destructor Destroy; override;
|
|
function NewThread: TIdThreadWithTask; virtual;
|
|
function NewYarn(AThread: TIdThreadWithTask = nil): TIdYarnOfThread;
|
|
procedure StartYarn(AYarn: TIdYarn; ATask: TIdTask); override;
|
|
procedure TerminateYarn(AYarn: TIdYarn); override;
|
|
property ThreadClass: TIdThreadWithTaskClass read FThreadClass write FThreadClass;
|
|
published
|
|
property MaxThreads: Integer read FMaxThreads write FMaxThreads;
|
|
property ThreadPriority: TIdThreadPriority read FThreadPriority write FThreadPriority default tpNormal;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF KYLIXCOMPAT}
|
|
Libc,
|
|
{$ENDIF}
|
|
IdResourceStringsCore, IdTCPServer, IdThreadSafe, IdExceptionCore, SysUtils;
|
|
|
|
{ TIdSchedulerOfThread }
|
|
|
|
destructor TIdSchedulerOfThread.Destroy;
|
|
begin
|
|
TerminateAllYarns;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TIdSchedulerOfThread.StartYarn(AYarn: TIdYarn; ATask: TIdTask);
|
|
var
|
|
LThread: TIdThreadWithTask;
|
|
begin
|
|
LThread := TIdYarnOfThread(AYarn).Thread;
|
|
LThread.Task := ATask;
|
|
LThread.Start;
|
|
end;
|
|
|
|
function TIdSchedulerOfThread.NewThread: TIdThreadWithTask;
|
|
begin
|
|
Assert(FThreadClass<>nil);
|
|
if (FMaxThreads <> 0) and (not ActiveYarns.IsCountLessThan(FMaxThreads + 1)) then begin
|
|
raise EIdSchedulerMaxThreadsExceeded.Create(RSchedMaxThreadEx);
|
|
end;
|
|
Result := FThreadClass.Create(nil, IndyFormat('%s User', [Name])); {do not localize}
|
|
if ThreadPriority <> tpNormal then begin
|
|
IndySetThreadPriority(Result, ThreadPriority);
|
|
end;
|
|
end;
|
|
|
|
function TIdSchedulerOfThread.NewYarn(AThread: TIdThreadWithTask): TIdYarnOfThread;
|
|
begin
|
|
if not Assigned(AThread) then begin
|
|
raise EIdException.Create(RSThreadSchedulerThreadRequired);
|
|
end;
|
|
// Create Yarn
|
|
Result := TIdYarnOfThread.Create(Self, AThread);
|
|
end;
|
|
|
|
procedure TIdSchedulerOfThread.TerminateYarn(AYarn: TIdYarn);
|
|
var
|
|
LYarn: TIdYarnOfThread;
|
|
begin
|
|
Assert(AYarn<>nil);
|
|
LYarn := TIdYarnOfThread(AYarn);
|
|
if (LYarn.Thread <> nil) and (not LYarn.Thread.Suspended) then begin
|
|
// Is still running and will free itself
|
|
LYarn.Thread.Stop;
|
|
// Dont free the yarn. The thread frees it (IdThread.pas)
|
|
end else
|
|
begin
|
|
// If suspended, was created but never started
|
|
// ie waiting on connection accept
|
|
|
|
// RLebeau: free the yarn here as well. This allows TIdSchedulerOfThreadPool
|
|
// to put the suspended thread, if present, back in the pool.
|
|
|
|
IdDisposeAndNil(LYarn);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdSchedulerOfThread.InitComponent;
|
|
begin
|
|
inherited InitComponent;
|
|
FThreadPriority := tpNormal;
|
|
FMaxThreads := 0;
|
|
FThreadClass := TIdThreadWithTask;
|
|
end;
|
|
|
|
{ TIdYarnOfThread }
|
|
|
|
constructor TIdYarnOfThread.Create(
|
|
AScheduler: TIdScheduler;
|
|
AThread: TIdThreadWithTask
|
|
);
|
|
begin
|
|
inherited Create;
|
|
FScheduler := AScheduler;
|
|
FThread := AThread;
|
|
AThread.Yarn := Self;
|
|
end;
|
|
|
|
destructor TIdYarnOfThread.Destroy;
|
|
begin
|
|
FScheduler.ReleaseYarn(Self);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
end.
|