| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134 |
- { $HDR$}
- {**********************************************************************}
- { Unit archived using Team Coherence }
- { Team Coherence is Copyright 2002 by Quality Software Components }
- { }
- { For further information / comments, visit our WEB site at }
- { http://www.TeamCoherence.com }
- {**********************************************************************}
- {}
- { $Log: 56072: IdFiberWeaverThreaded.pas
- {
- Rev 1.4 6/11/2004 8:39:56 AM DSiders
- Added "Do not Localize" comments.
- }
- {
- { Rev 1.3 2004-04-23 19:46:52 Mattias
- { TTempThread now uses WaitForFibers instead of sleep
- }
- {
- { Rev 1.2 2004.04.22 11:45:18 PM czhower
- { Bug fixes
- }
- {
- { Rev 1.1 2004.02.09 9:16:40 PM czhower
- { Updated to compile and match lib changes.
- }
- {
- { Rev 1.0 2004.02.03 12:38:54 AM czhower
- { Move
- }
- {
- { Rev 1.2 2003.10.21 12:19:22 AM czhower
- { TIdTask support and fiber bug fixes.
- }
- {
- { Rev 1.1 2003.10.19 4:38:32 PM czhower
- { Updates
- }
- unit IdFiberWeaverThreaded;
- interface
- uses
- Classes,
- IdFiberWeaverInline,
- IdThread, IdSchedulerOfThread, IdFiberWeaver, IdFiber;
- type
- TTempThread = class(TIdThread)
- protected
- FFiberWeaver: TIdFiberWeaverInline;
- //
- procedure AfterRun; override;
- procedure BeforeRun; override;
- procedure Run; override;
- end;
- TIdFiberWeaverThreaded = class(TIdFiberWeaver)
- protected
- FThreadScheduler: TIdSchedulerOfThread;
- FTempThread: TTempThread;
- //
- procedure InitComponent; override;
- public
- procedure Add(
- AFiber: TIdFiber
- ); override;
- destructor Destroy;
- override;
- published
- property ThreadScheduler: TIdSchedulerOfThread read FThreadScheduler
- write FThreadScheduler;
- end;
- implementation
- uses
- SysUtils;
- { TTempThread }
- procedure TTempThread.AfterRun;
- begin
- inherited;
- FreeAndNil(FFiberWeaver);
- end;
- procedure TTempThread.BeforeRun;
- begin
- inherited;
- //TODO: Make this pluggable at run time? depends where threads come
- //from - merge to scheduler? Base is in IdFiber though....
- FFiberWeaver := TIdFiberWeaverInline.Create(nil);
- FFiberWeaver.FreeFibersOnCompletion := True;
- end;
- procedure TTempThread.Run;
- begin
- //TODO: Temp hack
- if FFiberWeaver.HasFibers then begin
- FFiberWeaver.ProcessInThisThread;
- end else begin
- //Sleep(50);
- FFiberWeaver.WaitForFibers(50);
- end;
- end;
- { TIdFiberWeaverThreaded }
- procedure TIdFiberWeaverThreaded.Add(AFiber: TIdFiber);
- begin
- FTempThread.FFiberWeaver.Add(AFiber);
- end;
- destructor TIdFiberWeaverThreaded.Destroy;
- begin
- // is only created at run time
- if FTempThread <> nil then begin
- FTempThread.TerminateAndWaitFor;
- FreeAndNil(FTempThread);
- end;
- inherited;
- end;
- procedure TIdFiberWeaverThreaded.InitComponent;
- begin
- inherited;
- if not (csDesigning in ComponentState) then begin
- FTempThread := TTempThread.Create(False, True, 'TIdSchedulerOfFiber Temp'); {do not localize}
- end;
- end;
- end.
|