154 lines
3.3 KiB
Plaintext
154 lines
3.3 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.2 6/11/2004 8:40:06 AM DSiders
|
|
Added "Do not Localize" comments.
|
|
|
|
Rev 1.1 2004.02.09 9:16:48 PM czhower
|
|
Updated to compile and match lib changes.
|
|
|
|
Rev 1.0 2004.02.03 12:38:58 AM czhower
|
|
Move
|
|
|
|
Rev 1.9 2003.10.24 1:00:06 PM czhower
|
|
Name change
|
|
|
|
Rev 1.8 2003.10.21 12:19:20 AM czhower
|
|
TIdTask support and fiber bug fixes.
|
|
|
|
Rev 1.7 2003.10.19 4:38:34 PM czhower
|
|
Updates
|
|
|
|
Rev 1.6 2003.10.19 2:50:40 PM czhower
|
|
Fiber cleanup
|
|
|
|
Rev 1.5 2003.10.19 1:04:28 PM czhower
|
|
Updates
|
|
|
|
Rev 1.4 2003.10.14 11:17:06 PM czhower
|
|
Updates to match core changes.
|
|
|
|
Rev 1.3 2003.10.11 5:43:48 PM czhower
|
|
Chained servers now functional.
|
|
|
|
Rev 1.2 2003.09.19 10:09:42 PM czhower
|
|
Next stage of fiber support in servers.
|
|
}
|
|
|
|
unit IdSchedulerOfFiber;
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
IdFiberWeaver, IdTask, IdFiber, IdScheduler, IdYarn;
|
|
|
|
type
|
|
TIdSchedulerOfFiber = class;
|
|
|
|
TIdYarnOfFiber = class(TIdYarn)
|
|
protected
|
|
FFiber: TIdFiberWithTask;
|
|
FScheduler: TIdScheduler;
|
|
public
|
|
constructor Create(
|
|
AScheduler: TIdScheduler;
|
|
AFiber: TIdFiberWithTask
|
|
); reintroduce; virtual;
|
|
destructor Destroy;
|
|
override;
|
|
//
|
|
property Fiber: TIdFiberWithTask read FFiber;
|
|
end;
|
|
|
|
TIdSchedulerOfFiber = class(TIdScheduler)
|
|
protected
|
|
FFiberWeaver: TIdFiberWeaver;
|
|
public
|
|
function AcquireYarn
|
|
: TIdYarn;
|
|
override;
|
|
procedure StartYarn(
|
|
AYarn: TIdYarn;
|
|
ATask: TIdTask
|
|
); override;
|
|
procedure TerminateYarn(
|
|
AYarn: TIdYarn
|
|
); override;
|
|
published
|
|
//TODO: Need to add notification for this prop
|
|
//TODO: Dont allow setting while active
|
|
property FiberWeaver: TIdFiberWeaver read FFiberWeaver write FFiberWeaver;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
IdGlobal,
|
|
SysUtils;
|
|
|
|
{ TIdSchedulerOfFiber }
|
|
|
|
function TIdSchedulerOfFiber.AcquireYarn: TIdYarn;
|
|
var
|
|
LFiber: TIdFiberWithTask;
|
|
begin
|
|
LFiber := TIdFiberWithTask.Create(nil, nil, Format('%s User', [Name])); {do not localize}
|
|
Result := TIdYarnOfFiber.Create(Self, LFiber);
|
|
ActiveYarns.Add(Result);
|
|
end;
|
|
|
|
procedure TIdSchedulerOfFiber.StartYarn(
|
|
AYarn: TIdYarn;
|
|
ATask: TIdTask
|
|
);
|
|
begin
|
|
inherited;
|
|
TIdYarnOfFiber(AYarn).Fiber.Task := ATask;
|
|
// Last - Put it in the queue to be scheduled
|
|
Assert(FiberWeaver<>nil);
|
|
FiberWeaver.Add(TIdYarnOfFiber(AYarn).Fiber);
|
|
end;
|
|
|
|
procedure TIdSchedulerOfFiber.TerminateYarn(AYarn: TIdYarn);
|
|
begin
|
|
// Fibers dont "run", so we dont terminate them
|
|
FreeAndNil(AYarn);
|
|
end;
|
|
|
|
{ TIdYarnOfFiber }
|
|
|
|
constructor TIdYarnOfFiber.Create(
|
|
AScheduler: TIdScheduler;
|
|
AFiber: TIdFiberWithTask
|
|
);
|
|
begin
|
|
inherited Create;
|
|
FScheduler := AScheduler;
|
|
FFiber := AFiber;
|
|
AFiber.Yarn := Self;
|
|
end;
|
|
|
|
destructor TIdYarnOfFiber.Destroy;
|
|
begin
|
|
FScheduler.ReleaseYarn(Self);
|
|
inherited;
|
|
end;
|
|
|
|
end.
|