362 lines
11 KiB
Plaintext
362 lines
11 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:39:52 AM DSiders
|
|
Added "Do not Localize" comments.
|
|
|
|
Rev 1.1 2004.02.09 9:16:38 PM czhower
|
|
Updated to compile and match lib changes.
|
|
|
|
Rev 1.0 2004.02.03 12:38:52 AM czhower
|
|
Move
|
|
|
|
Rev 1.2 2003.11.04 3:51:20 PM czhower
|
|
Update to sync TC
|
|
|
|
Rev 1.1 2003.10.21 12:19:22 AM czhower
|
|
TIdTask support and fiber bug fixes.
|
|
|
|
Rev 1.0 2003.10.19 2:50:54 PM czhower
|
|
Fiber cleanup
|
|
|
|
Rev 1.4 2003.10.19 1:04:26 PM czhower
|
|
Updates
|
|
|
|
Rev 1.3 2003.10.11 5:43:20 PM czhower
|
|
Chained servers now functional.
|
|
|
|
Rev 1.2 2003.09.19 10:09:40 PM czhower
|
|
Next stage of fiber support in servers.
|
|
|
|
Rev 1.1 2003.08.20 1:46:22 PM czhower
|
|
Update to compile.
|
|
|
|
Rev 1.0 8/16/2003 11:09:12 AM JPMugaas
|
|
Moved from Indy Core dir as part of package reorg
|
|
|
|
Rev 1.8 7/26/2003 12:20:02 PM BGooijen
|
|
Small fix to prevent some exceptions
|
|
|
|
Rev 1.7 2003.06.30 7:33:50 PM czhower
|
|
Fix to exception handling.
|
|
|
|
Rev 1.6 2003.06.25 1:25:58 AM czhower
|
|
Small changes.
|
|
|
|
Rev 1.4 2003.06.03 11:05:02 PM czhower
|
|
Modified ProcessInThisFiber to support error flag return.
|
|
|
|
Rev 1.3 2003.04.17 7:44:58 PM czhower
|
|
|
|
Rev 1.2 4/11/2003 6:37:38 PM BGooijen
|
|
ProcessInThisFiber and WaitForFibers are now overridden here
|
|
|
|
Rev 1.1 2003.04.10 10:51:06 PM czhower
|
|
|
|
Rev 1.14 3/27/2003 12:34:02 PM BGooijen
|
|
very little clean-up
|
|
|
|
Rev 1.13 2003.03.27 1:31:18 AM czhower
|
|
Removal of hack cast.
|
|
|
|
Rev 1.12 2003.03.27 1:29:16 AM czhower
|
|
Exception frame swapping.
|
|
|
|
Rev 1.11 2003.03.27 12:45:58 AM czhower
|
|
Fixed AV relating to preparation changes for exception frame swapping
|
|
|
|
Rev 1.10 2003.03.27 12:18:06 AM czhower
|
|
|
|
Rev 1.9 3/26/2003 8:37:50 PM BGooijen
|
|
Added WaitForFibers
|
|
|
|
Rev 1.8 2003.03.26 12:48:30 AM czhower
|
|
|
|
Rev 1.7 3/25/2003 01:58:20 PM JPMugaas
|
|
Fixed a type-error.
|
|
|
|
Rev 1.6 3/25/2003 01:27:56 AM JPMugaas
|
|
Made a custom exception class that descends from EIdSIlentException so that
|
|
the component does not always raise an exception in the server if there's no
|
|
client connection.
|
|
|
|
Rev 1.5 2003.03.16 12:49:32 PM czhower
|
|
|
|
Rev 1.4 3/13/2003 10:18:14 AM BGooijen
|
|
Server side fibers, bug fixes
|
|
|
|
Rev 1.3 12-15-2002 17:08:00 BGooijen
|
|
Removed AssignList, and added a hack-cast to use .Assign
|
|
|
|
Rev 1.2 2002.12.07 11:10:30 PM czhower
|
|
Removed unneeded code.
|
|
|
|
Rev 1.1 12-6-2002 20:34:10 BGooijen
|
|
Now compiles on Delphi 5
|
|
|
|
Rev 1.0 11/13/2002 08:44:26 AM JPMugaas
|
|
}
|
|
|
|
unit IdFiberWeaverInline;
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, IdException,
|
|
IdGlobal, IdFiber, IdFiberWeaver, IdThreadSafe,
|
|
SyncObjs;
|
|
|
|
type
|
|
TIdFiberWeaverInline = class;
|
|
|
|
TIdFiberNotifyEvent = procedure(AFiberWeaver: TIdFiberWeaverInline;
|
|
AFiber: TIdFiberBase) of object;
|
|
|
|
TIdFiberWeaverInline = class(TIdFiberWeaver)
|
|
protected
|
|
// TIdThreadSafeInteger cannot be used for FActiveFiberList because the
|
|
// semantics cause the first fiber to be counted more than once during
|
|
// finish, and possibly other fibers as well. The only other solution
|
|
// involves using TIdFiber itself, and that would cause changes to TIdFiber
|
|
// that would be made only for the accomodation of TIdFiberWeaverInline.
|
|
//
|
|
// As it is TIdFiber itself has no knowledge ot TIdFiberWeaverInline.
|
|
//
|
|
// FActiveFiberList is used by ProcessInThisThread to detect when all fibers
|
|
// have finished.
|
|
FActiveFiberList: TIdThreadSafeList;
|
|
FAddEvent: TEvent;
|
|
// FActiveFiberList contains a list of fibers to schedule. Fibers are
|
|
// removed when they are running or are suspened. When a fiber is ready to
|
|
// excecuted again it is added to FActiveFiberList and the fiber weaver will
|
|
// schedule it.
|
|
FFiberList: TIdThreadSafeList;
|
|
FFreeFibersOnCompletion: Boolean;
|
|
FOnIdle: TNotifyEvent;
|
|
FOnSwitch: TIdFiberNotifyEvent;
|
|
FSelfFiber: TIdConvertedFiber;
|
|
//
|
|
procedure DoIdle;
|
|
procedure DoSwitch(AFiber: TIdFiberBase); virtual;
|
|
procedure InitComponent; override;
|
|
procedure Relinquish(
|
|
AFiber: TIdFiber;
|
|
AReschedule: Boolean
|
|
); override;
|
|
procedure ScheduleFiber(
|
|
ACurrentFiber: TIdFiberBase;
|
|
ANextFiber: TIdFiber
|
|
);
|
|
public
|
|
procedure Add(AFiber: TIdFiber); override;
|
|
destructor Destroy; override;
|
|
function HasFibers: Boolean;
|
|
function ProcessInThisThread: Boolean;
|
|
function WaitForFibers(
|
|
ATimeout: Cardinal = Infinite
|
|
): Boolean;
|
|
override;
|
|
published
|
|
property FreeFibersOnCompletion: Boolean read FFreeFibersOnCompletion
|
|
write FFreeFibersOnCompletion;
|
|
//
|
|
property OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
|
|
property OnSwitch: TIdFiberNotifyEvent read FOnSwitch write FOnSwitch;
|
|
end;
|
|
EIdNoFibersToSchedule = class(EIdSilentException);
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
Windows;
|
|
|
|
{ TIdFiberWeaverInline }
|
|
|
|
procedure TIdFiberWeaverInline.Add(AFiber: TIdFiber);
|
|
begin
|
|
inherited;
|
|
AFiber.SetRelinquishHandler(Relinquish);
|
|
with FFiberList.LockList do try
|
|
Add(AFiber);
|
|
FAddEvent.SetEvent;
|
|
finally FFiberList.UnlockList; end;
|
|
end;
|
|
|
|
destructor TIdFiberWeaverInline.Destroy;
|
|
begin
|
|
FreeAndNil(FActiveFiberList);
|
|
FreeAndNil(FFiberList);
|
|
FreeAndNil(FAddEvent);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TIdFiberWeaverInline.DoIdle;
|
|
begin
|
|
if Assigned(FOnIdle) then begin
|
|
FOnIdle(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdFiberWeaverInline.DoSwitch(AFiber: TIdFiberBase);
|
|
begin
|
|
if Assigned(FOnSwitch) then begin
|
|
FOnSwitch(Self, AFiber);
|
|
end;
|
|
end;
|
|
|
|
function TIdFiberWeaverInline.HasFibers: Boolean;
|
|
begin
|
|
Result := not FFiberList.IsCountLessThan(1);
|
|
end;
|
|
|
|
procedure TIdFiberWeaverInline.InitComponent;
|
|
begin
|
|
inherited;
|
|
FActiveFiberList := TIdThreadSafeList.Create;
|
|
FAddEvent := TEvent.Create(nil, False, False, '');
|
|
FFiberList := TIdThreadSafeList.Create;
|
|
end;
|
|
|
|
function TIdFiberWeaverInline.ProcessInThisThread: Boolean;
|
|
// Returns true if ANY fiber terminated because of an unhandled exception.
|
|
// If false, user does not need to loop through the fibers to look.
|
|
var
|
|
LFiber: TIdFiber;
|
|
LFiberList: TList;
|
|
begin
|
|
Result := False;
|
|
LFiberList := FFiberList.LockList; try
|
|
if LFiberList.Count = 0 then begin
|
|
raise EIdNoFibersToSchedule.Create('No fibers to schedule.'); {do not localize}
|
|
end;
|
|
FActiveFiberList.Assign(LFiberList);
|
|
finally FFiberList.UnlockList; end;
|
|
// This loop catches fibers as they finish. Relinquish accomplishes explicit
|
|
// switching faster by performing only one switch instead of two.
|
|
FSelfFiber := TIdConvertedFiber.Create; try
|
|
while True do begin
|
|
LFiber := TIdFiber(FFiberList.Pull);
|
|
if LFiber = nil then begin
|
|
if FActiveFiberList.IsEmpty then begin
|
|
// All fibers finished
|
|
Break;
|
|
end else begin
|
|
FAddEvent.WaitFor(Infinite);
|
|
end;
|
|
end else begin
|
|
// So it will switch back here when finished so other fibers can be
|
|
// processed.
|
|
LFiber.ParentFiber := FSelfFiber;
|
|
//
|
|
ScheduleFiber(FSelfFiber, LFiber);
|
|
// if any fiber terminated with a fatal exception return true
|
|
// Dont set it to it, else false would reset it.
|
|
if FSelfFiber.PriorFiber is TIdFiber then begin
|
|
LFiber := TIdFiber(FSelfFiber.PriorFiber);
|
|
if LFiber.FatalExceptionOccurred then begin
|
|
Result := True;
|
|
end;
|
|
// Finished fibers always switch back to parent and will not short
|
|
// circuit schedule
|
|
if LFiber.Finished then begin
|
|
FActiveFiberList.Remove(LFiber);
|
|
if FreeFibersOnCompletion then begin
|
|
FreeAndNil(LFiber);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally FreeAndNil(FSelfFiber); end;
|
|
end;
|
|
|
|
procedure TIdFiberWeaverInline.Relinquish(
|
|
AFiber: TIdFiber;
|
|
AReschedule: Boolean
|
|
);
|
|
var
|
|
LFiber: TIdFiber;
|
|
begin
|
|
while True do begin
|
|
LFiber := nil;
|
|
// Get next fiber to schedule
|
|
with FFiberList.LockList do try
|
|
if Count > 0 then begin
|
|
LFiber := TIdFiber(List[0]);
|
|
Delete(0);
|
|
if AReschedule then begin
|
|
Add(AFiber);
|
|
end;
|
|
// If no fibers to schedule, we will rerun ourself if set to reschedule
|
|
end else if AReschedule then begin
|
|
// Soft cast as a check that a converted fiber has not been passed
|
|
// with AReschedule = True
|
|
LFiber := AFiber as TIdFiber;
|
|
end;
|
|
finally FFiberList.UnlockList; end;
|
|
if LFiber = nil then begin
|
|
// If there are no fibers to schedule, that means we are waiting on
|
|
// ourself, or another relinquished fiber. Wait for one to get readded
|
|
// to list.
|
|
//
|
|
//TODO: Allow a parameter for timeout and call DoIdle
|
|
//TODO: Better yet - integrate with AntiFreeze also
|
|
DoIdle;
|
|
FAddEvent.WaitFor(Infinite);
|
|
end else if LFiber = AFiber then begin
|
|
// If the next fiber is ourself, simply exit to return to ourself
|
|
Break;
|
|
end else if LFiber <> nil then begin
|
|
// Must set the parent fiber to self so that when it finishes we get
|
|
// control again. The main ProcessInThisThread loop does this, but
|
|
// only for ones it first starts. Fibers can get added to the list and
|
|
// then scheduled here in this short circuit switch. When they finish
|
|
// they will have no parent fiber.
|
|
LFiber.ParentFiber := FSelfFiber;
|
|
ScheduleFiber(AFiber, LFiber);
|
|
// If we get switched back to, we have been scheduled so exit
|
|
Break;
|
|
end;
|
|
end;
|
|
// For future expansion when can switch between weavers
|
|
AFiber.SetRelinquishHandler(Relinquish);
|
|
end;
|
|
|
|
procedure TIdFiberWeaverInline.ScheduleFiber(
|
|
ACurrentFiber: TIdFiberBase;
|
|
ANextFiber: TIdFiber
|
|
);
|
|
begin
|
|
DoSwitch(ANextFiber);
|
|
ACurrentFiber.SwitchTo(ANextFiber);
|
|
end;
|
|
|
|
function TIdFiberWeaverInline.WaitForFibers(
|
|
ATimeout: Cardinal = Infinite
|
|
): Boolean;
|
|
begin
|
|
if not FFiberList.IsEmpty then begin
|
|
Result := True;
|
|
end else begin
|
|
Result := (FAddEvent.WaitFor(ATimeout) = wrSignaled) and not FFiberList.IsEmpty;
|
|
end;
|
|
end;
|
|
|
|
end.
|