restemplate/indy/Core/IdSync.pas

547 lines
14 KiB
Plaintext
Raw Normal View History

{
$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.13 03/16/05 11:15:42 AM JSouthwell
Named the IdNotify thread for simpler debugging.
Rev 1.12 2004.04.13 10:22:52 PM czhower
Changed procedure to class method.
Rev 1.11 4/12/2004 11:44:36 AM BGooijen
fix
Rev 1.10 4/12/2004 11:36:56 AM BGooijen
NotifyThread can be cleaned up with procedure now
Rev 1.9 2004.03.11 10:14:46 AM czhower
Improper cast fixed.
Rev 1.8 2004.02.29 8:23:16 PM czhower
Fixed visibility mismatch.
Rev 1.7 2004.02.25 10:11:42 AM czhower
Fixed visibility in notify
Rev 1.6 2004.02.03 4:16:54 PM czhower
For unit name changes.
Rev 1.5 1/1/2004 11:56:10 PM PIonescu
Fix for TIdNotifyMethod's constructor
Rev 1.4 2003.12.31 7:33:20 PM czhower
Constructor bug fix.
Rev 1.3 5/12/2003 9:17:42 AM GGrieve
compile fix
Rev 1.2 2003.09.18 5:42:14 PM czhower
Removed TIdThreadBase
Rev 1.1 05.6.2003 <20>. 11:30:12 DBondzhev
Mem leak fix for notifiers created in main thread. Also WaitFor for waiting
notification to be executed.
Rev 1.0 11/13/2002 09:00:10 AM JPMugaas
}
unit IdSync;
// Author: Chad Z. Hower - a.k.a. Kudzu
interface
{$i IdCompilerDefines.inc}
{$UNDEF NotifyThreadNeeded}
{$UNDEF TNotify_InternalDoNotify_Needed}
{$IFNDEF HAS_STATIC_TThread_Synchronize}
{$DEFINE NotifyThreadNeeded}
{$ENDIF}
{$IFNDEF HAS_STATIC_TThread_Queue}
{$DEFINE NotifyThreadNeeded}
{$ELSE}
{$IFNDEF USE_OBJECT_ARC}
{$DEFINE TNotify_InternalDoNotify_Needed}
{$ENDIF}
{$ENDIF}
uses
Classes,
IdGlobal
{$IFDEF NotifyThreadNeeded}
, IdThread
{$ENDIF}
;
type
TIdSync = class(TObject)
protected
{$IFNDEF HAS_STATIC_TThread_Synchronize}
FThread: TIdThread;
{$ENDIF}
//
procedure DoSynchronize; virtual; abstract;
public
{$IFDEF HAS_STATIC_TThread_Synchronize}
constructor Create; virtual;
{$ELSE}
constructor Create; overload; virtual;
constructor Create(AThread: TIdThread); overload; virtual;
{$ENDIF}
procedure Synchronize;
class procedure SynchronizeMethod(AMethod: TThreadMethod);
//
{$IFNDEF HAS_STATIC_TThread_Synchronize}
property Thread: TIdThread read FThread;
{$ENDIF}
end;
TIdNotify = class(TObject)
protected
FMainThreadUsesNotify: Boolean;
//
procedure DoNotify; virtual; abstract;
{$IFDEF TNotify_InternalDoNotify_Needed}
procedure InternalDoNotify;
{$ENDIF}
public
constructor Create; virtual; // here to make virtual
procedure Notify;
{$IFNDEF HAS_STATIC_TThread_Queue}
procedure WaitFor; {$IFDEF HAS_DEPRECATED}deprecated;{$ENDIF}
{$ENDIF}
class procedure NotifyMethod(AMethod: TThreadMethod);
//
property MainThreadUsesNotify: Boolean read FMainThreadUsesNotify write FMainThreadUsesNotify; // deprecated
end;
TIdNotifyMethod = class(TIdNotify)
protected
FMethod: TThreadMethod;
//
procedure DoNotify; override;
public
constructor Create(AMethod: TThreadMethod); reintroduce; virtual;
end {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use TIdNotify.NotifyMethod()'{$ENDIF}{$ENDIF};
implementation
uses
//facilitate inlining only.
{$IFDEF DOTNET}
{$IFDEF USE_INLINE}
System.Threading,
{$ENDIF}
{$ENDIF}
{$IFDEF NotifyThreadNeeded}
{$IFDEF HAS_UNIT_Generics_Collections}
System.Generics.Collections,
{$ENDIF}
{$ENDIF}
{$IFDEF VCL_2010_OR_ABOVE}
{$IFDEF WINDOWS}
Windows,
{$ENDIF}
{$ENDIF}
{$IFDEF USE_VCL_POSIX}
Posix.SysSelect,
Posix.SysTime,
{$ENDIF}
SysUtils
{$IFNDEF NotifyThreadNeeded}
, IdThread
{$ENDIF}
;
// TODO: there is a bug in FireMonkey prior to XE7 where FMX.TApplication does
// not assign a handler to the Classes.WakeMainThread callback (see QC #123579).
// Without that, TThread.Synchronize() and TThread.Queue() will not do anything
// if the main message queue is idle at the moment they are called!!! If the
// main thread *happens* to receive a message at a later time, say from UI
// activity, then they will be processed. But for a background process, we
// cannot rely on that. Need an alternative solution for those versions of
// FireMonkey...
{$IFDEF NotifyThreadNeeded}
type
// This is done with a NotifyThread instead of PostMessage because starting
// with D6/Kylix Borland radically modified the mechanisms for .Synchronize.
// This is a bit more code in the end, but its source compatible and does not
// rely on Indy directly accessing any OS APIs and performance is still more
// than acceptable, especially considering Notifications are low priority.
{$IFDEF HAS_GENERICS_TThreadList}
TIdNotifyThreadList = TThreadList<TIdNotify>;
TIdNotifyList = TList<TIdNotify>;
{$ELSE}
// TODO: flesh out to match TThreadList<TIdNotify> and TList<TIdNotify> for non-Generics compilers...
TIdNotifyThreadList = TThreadList;
TIdNotifyList = TList;
{$ENDIF}
TIdNotifyThread = class(TIdThread)
protected
FEvent: TIdLocalEvent;
FNotifications: TIdNotifyThreadList;
public
procedure AddNotification(ASync: TIdNotify);
constructor Create; reintroduce;
destructor Destroy; override;
class procedure FreeThread;
procedure Run; override;
end;
var
GNotifyThread: TIdNotifyThread = nil;
procedure CreateNotifyThread;
begin
// TODO: this function has a race condition if it is called by multiple
// threads at the same time and GNotifyThread has not been assigned yet!
// Need to use something like InterlockedCompareExchangeObj() so any
// duplicate threads can be freed...
{
Thread := TIdNotifyThread.Create(True);
if InterlockedCompareExchangeObj(GNotifyThread, Thread, nil) <> nil then begin
Thread.Free;
end else begin
Thread.Start;
end;
}
if GNotifyThread = nil then begin
GNotifyThread := TIdNotifyThread.Create;
end;
end;
{$ENDIF}
{ TIdSync }
{$IFNDEF HAS_STATIC_TThread_Synchronize}
constructor TIdSync.Create(AThread: TIdThread);
begin
inherited Create;
FThread := AThread;
end;
{$ENDIF}
constructor TIdSync.Create;
begin
{$IFDEF HAS_STATIC_TThread_Synchronize}
inherited Create;
{$ELSE}
{$IFDEF DOTNET}
inherited Create;
CreateNotifyThread;
FThread := GNotifyThread;
{$ELSE}
CreateNotifyThread;
Create(GNotifyThread);
{$ENDIF}
{$ENDIF}
end;
procedure DoThreadSync(AThread: TIdThread; SyncProc: TThreadMethod);
begin
{
if not Assigned(Classes.WakeMainThread) then
begin
// TODO: if WakeMainThread is not assigned, need to force a message into
// the main message queue so TApplication.Idle() will be called so it can
// call CheckSynchronize():
//
// on Windows, call PostMessage() to post a WM_NULL message to the TApplication window...
//
// on OSX (and iOS?), call NSApp.sendEvent(???), but with what kind of event?
//
// on Android, what to do???
// We can't put the message in the queue before calling TThread.Synchronize(),
// as it might get processed before Synchronize() can queue the procedure.
// Might have to use TThread.Queue() instead and wait on a manual TEvent...
end else
begin
}
{$IFDEF HAS_STATIC_TThread_Synchronize}
TThread.Synchronize(AThread, SyncProc);
{$ELSE}
AThread.Synchronize(SyncProc);
{$ENDIF}
// end;
end;
{$IFDEF HAS_STATIC_TThread_Queue}
procedure DoThreadQueue(QueueProc: TThreadMethod);
begin
{
if not Assigned(Classes.WakeMainThread) then
begin
// TODO: if WakeMainThread is not assigned, need to force a message into
// the main message queue so TApplication.Idle() will be called so it can
// call CheckSynchronize():
//
// on Windows, call PostMessage() to post a WM_NULL message to the TApplication window...
//
// on OSX (and iOS?), call NSApp.sendEvent(???), but with what kind of event?
//
// on Android, what to do???
// We can't put the message in the queue before calling TThread.Queue(),
// as it might get processed before Queue() can queue the procedure.
// Might have to wait on a manual TEvent...
end else
begin
}
TThread.Queue(nil, QueueProc);
// end;
end;
{$ENDIF}
procedure TIdSync.Synchronize;
begin
DoThreadSync(
{$IFDEF HAS_STATIC_TThread_Synchronize}nil{$ELSE}FThread{$ENDIF},
DoSynchronize
);
end;
class procedure TIdSync.SynchronizeMethod(AMethod: TThreadMethod);
begin
{$IFDEF HAS_STATIC_TThread_Synchronize}
DoThreadSync(nil, AMethod);
{$ELSE}
CreateNotifyThread;
DoThreadSync(GNotifyThread, AMethod);
{$ENDIF}
end;
{ TIdNotify }
constructor TIdNotify.Create;
begin
inherited Create;
end;
procedure TIdNotify.Notify;
begin
// Note: MainThreadUsesNotify only has meaning now when TThread.Queue() is
// not available, as it calls the specified method immediately if invoked
// in the main thread! To go back to the old behavior, we would have to
// re-enable use of TIdNotifyThread, which is another interface change...
if InMainThread and (not MainThreadUsesNotify) then begin
{$IFNDEF USE_OBJECT_ARC}
try
{$ENDIF}
DoNotify;
{$IFNDEF USE_OBJECT_ARC}
finally
Free;
end;
{$ENDIF}
end else begin
{$IFNDEF USE_OBJECT_ARC}
try
{$ENDIF}
{$IFDEF HAS_STATIC_TThread_Queue}
DoThreadQueue(
{$IFDEF TNotify_InternalDoNotify_Needed}
InternalDoNotify
{$ELSE}
DoNotify
{$ENDIF}
);
{$ELSE}
CreateNotifyThread;
GNotifyThread.AddNotification(Self);
{$ENDIF}
{$IFNDEF USE_OBJECT_ARC}
except
Free;
raise;
end;
{$ENDIF}
end;
end;
{$IFDEF TNotify_InternalDoNotify_Needed}
procedure TIdNotify.InternalDoNotify;
begin
try
DoNotify;
finally
Free;
end;
end;
{$ENDIF}
class procedure TIdNotify.NotifyMethod(AMethod: TThreadMethod);
begin
{$IFDEF HAS_STATIC_TThread_Queue}
DoThreadQueue(AMethod);
{$ELSE}
{$I IdSymbolDeprecatedOff.inc}
TIdNotifyMethod.Create(AMethod).Notify;
{$I IdSymbolDeprecatedOn.inc}
{$ENDIF}
end;
{$IFNDEF HAS_STATIC_TThread_Queue}
// RLebeau: this method does not make sense. The Self pointer is not
// guaranteed to remain valid while this method is running since the
// notify thread frees the object. Also, this makes the calling thread
// block, so TIdSync should be used instead...
{$I IdDeprecatedImplBugOff.inc}
procedure TIdNotify.WaitFor;
{$I IdDeprecatedImplBugOn.inc}
var
LNotifyIndex: Integer;
LList: TIdNotifyList;
begin
repeat
LList := GNotifyThread.FNotifications.LockList;
try
LNotifyIndex := LList.IndexOf(Self);
finally
GNotifyThread.FNotifications.UnlockList;
end;
if LNotifyIndex = -1 then begin
Break;
end;
IndySleep(10);
until False;
end;
{$ENDIF}
{$IFDEF NotifyThreadNeeded}
{ TIdNotifyThread }
procedure TIdNotifyThread.AddNotification(ASync: TIdNotify);
begin
FNotifications.Add(ASync);
FEvent.SetEvent;
end;
constructor TIdNotifyThread.Create;
begin
FEvent := TIdLocalEvent.Create;
FNotifications := TIdNotifyThreadList.Create;
// Must be before - Thread starts running when we call inherited
inherited Create(False, False, 'IdNotify');
end;
destructor TIdNotifyThread.Destroy;
var
{$IFNDEF USE_OBJECT_ARC}
LNotify: TIdNotify;
{$ENDIF}
LList: TIdNotifyList;
begin
// Free remaining Notifications if there is somthing that is still in
// the queue after thread was terminated
LList := FNotifications.LockList;
try
{$IFDEF USE_OBJECT_ARC}
LList.Clear; // Items are auto-freed
{$ELSE}
while LList.Count > 0 do begin
LNotify := {$IFDEF HAS_GENERICS_TList}LList.Items[0]{$ELSE}TIdNotify(LList.Items[0]){$ENDIF};
LNotify.Free;
LList.Delete(0);
end;
{$ENDIF}
finally
FNotifications.UnlockList;
end;
FreeAndNil(FNotifications);
FreeAndNil(FEvent);
inherited Destroy;
end;
class procedure TIdNotifyThread.FreeThread;
begin
if GNotifyThread <> nil then begin
GNotifyThread.Stop;
GNotifyThread.FEvent.SetEvent;
GNotifyThread.WaitFor;
// Instead of FreeOnTerminate so we can set the reference to nil
FreeAndNil(GNotifyThread);
end;
end;
procedure TIdNotifyThread.Run;
// NOTE: Be VERY careful with making changes to this proc. It is VERY delicate and the order
// of execution is very important. Small changes can have drastic effects
var
LNotifications: TIdNotifyList;
LNotify: TIdNotify;
begin
FEvent.WaitForEver;
// If terminated while waiting on the event or during the loop
while not Stopped do begin
try
LNotifications := FNotifications.LockList;
try
if LNotifications.Count = 0 then begin
Break;
end;
LNotify := {$IFDEF HAS_GENERICS_TList}LNotifications.Items[0]{$ELSE}TIdNotify(LNotifications.Items[0]){$ENDIF};
LNotifications.Delete(0);
finally
FNotifications.UnlockList;
end;
try
DoThreadSync(Self, LNotify.DoNotify);
finally
FreeAndNil(LNotify);
end;
except // Catch all exceptions especially these which are raised during the application close
end;
end;
end;
{$ENDIF} // NotifyThreadNeeded
{ TIdNotifyMethod }
{$I IdDeprecatedImplBugOff.inc}
constructor TIdNotifyMethod.Create(AMethod: TThreadMethod);
{$I IdDeprecatedImplBugOn.inc}
begin
inherited Create;
FMethod := AMethod;
end;
{$I IdDeprecatedImplBugOff.inc}
procedure TIdNotifyMethod.DoNotify;
{$I IdDeprecatedImplBugOn.inc}
begin
FMethod;
end;
{$IFDEF NotifyThreadNeeded}
initialization
finalization
TIdNotifyThread.FreeThread;
{$ENDIF}
end.