Changeset 246 for Common

Timestamp:

May 24, 2011, 12:34:59 PM (13 years ago)

Author:

george

Message:

• Modified: Threading unit now use concept of virtual TThread classes derived from TVirtualThread abstract class. Currently it only implements enhanced base thread class. In additional other threading principles as cooperative threading can be implemented.

File:

• Common/UThreading.pas (modified) (8 diffs)

Common/UThreading.pas

@@ -12 +12 @@
   TMethodCall = procedure of object;
 
+
+  { TVirtualThread }
+
+  TVirtualThread = class
+  private
+    function GetFreeOnTerminate: Boolean; virtual; abstract;
+    function GetPriority: TThreadPriority; virtual; abstract;
+    function GetSuspended: Boolean; virtual; abstract;
+    function GetTerminated: Boolean; virtual; abstract;
+    function GetThreadId: Integer; virtual; abstract;
+    procedure SetFreeOnTerminate(const AValue: Boolean); virtual; abstract;
+    procedure SetPriority(const AValue: TThreadPriority); virtual; abstract;
+    procedure SetSuspended(const AValue: Boolean); virtual; abstract;
+    procedure SetTerminated(const AValue: Boolean); virtual; abstract;
+  public
+    Name: string;
+    procedure Execute; virtual; abstract;
+    procedure Resume; virtual; abstract;
+    procedure Suspend; virtual; abstract;
+    procedure Start; virtual; abstract;
+    procedure Terminate; virtual; abstract;
+    procedure Synchronize(AMethod: TThreadMethod); virtual; abstract;
+    procedure WaitFor; virtual; abstract;
+    procedure Sleep(Delay: Integer); virtual; abstract;
+    property FreeOnTerminate: Boolean read GetFreeOnTerminate
+      write SetFreeOnTerminate;
+    property Suspended: Boolean read GetSuspended
+      write SetSuspended;
+    property Priority: TThreadPriority read GetPriority write SetPriority;
+    property Terminated: Boolean read GetTerminated write SetTerminated;
+    property ThreadId: Integer read GetThreadId;
+  end;
+
+  TListedThread = class;
+
+  { TListedThreadExecute }
+
+  TListedThreadExecute = class(TThread)
+    Parent: TListedThread;
+    procedure Execute; override;
+  end;
+
   { TListedThread }
 
-  TListedThread = class(TThread)
-    Name: string;
+  TListedThread = class(TVirtualThread)
+  private
+    FTerminated: Boolean;
+    FThread: TListedThreadExecute;
+    function GetFreeOnTerminate: Boolean; override;
+    function GetPriority: TThreadPriority; override;
+    function GetSuspended: Boolean; override;
+    function GetTerminated: Boolean; override;
+    function GetThreadId: Integer; override;
+    procedure SetFreeOnTerminate(const AValue: Boolean); override;
+    procedure SetPriority(const AValue: TThreadPriority); override;
+    procedure SetSuspended(const AValue: Boolean); override;
+    procedure SetTerminated(const AValue: Boolean); override;
+  public
     constructor Create(CreateSuspended: Boolean;
                        const StackSize: SizeUInt = DefaultStackSize);
     destructor Destroy; override;
-    procedure Sleep(Delay: Integer);
-    property Terminated;
+    procedure Sleep(Delay: Integer); override;
+    procedure Execute; override;
+    procedure Resume; override;
+    procedure Suspend; override;
+    procedure Start; override;
+    procedure Terminate; override;
+    procedure Synchronize(AMethod: TThreadMethod); override;
+    procedure WaitFor; override;
   end;
 
@@ -33 +93 @@
   end;
 
-var
-  ThreadList: TObjectList; // TList<TListedThread>
+  { TThreadList }
+
+  TThreadList = class(TObjectList)
+    function FindById(Id: Integer): TVirtualThread;
+    constructor Create;
+  end;
+
+var
+  ThreadList: TThreadList;
   ThreadListLock: TCriticalSection;
   OnException: TExceptionEvent;
@@ -42 +109 @@
 
 resourcestring
-  SCurrentThreadNotFound = 'Current thread ID %d not found in list.';
+  SCurrentThreadNotFound = 'Current thread ID %d not found in virtual thread list.';
 
 
@@ -68 +135 @@
 var
   I: Integer;
-  Thread: TListedThread;
+  Thread: TVirtualThread;
 begin
   if MainThreadID = ThreadID then Method
   else begin
-    I := 0;
-    while (I < ThreadList.Count) and (TListedThread(ThreadList[I]).ThreadID <> ThreadID) do
-      Inc(I);
-    if I < ThreadList.Count then begin
-      Thread := TListedThread(ThreadList[I]);
-      TThread.Synchronize(Thread, Method);
+    Thread := ThreadList.FindById(ThreadID);
+    if Assigned(Thread) then begin
+      Thread.Synchronize(Method);
     end else raise Exception.Create(Format(SCurrentThreadNotFound, [ThreadID]));
   end;
 end;
 
+{ TVirtualThread }
+
+
+{ TThreadList }
+
+function TThreadList.FindById(Id: Integer): TVirtualThread;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < ThreadList.Count) and (TVirtualThread(ThreadList[I]).ThreadID <> Id) do
+    Inc(I);
+  if I < ThreadList.Count then Result := TVirtualThread(ThreadList[I])
+    else Result := nil;
+end;
+
+constructor TThreadList.Create;
+begin
+  inherited Create;
+  OwnsObjects := False;
+end;
+
+{ TListedThreadExecute }
+
+procedure TListedThreadExecute.Execute;
+begin
+  try
+    Parent.Execute;
+  except
+    on E: Exception do
+      if Assigned(OnException) then
+        OnException(Parent.FThread, E);
+  end;
+end;
+
+{ TVirtualThread }
+
+
 { TListedThread }
+
+function TListedThread.GetFreeOnTerminate: Boolean;
+begin
+  Result := FThread.FreeOnTerminate;
+end;
+
+function TListedThread.GetPriority: TThreadPriority;
+begin
+  Result := FThread.Priority;
+end;
+
+function TListedThread.GetSuspended: Boolean;
+begin
+  Result := FThread.Suspended;
+end;
+
+function TListedThread.GetTerminated: Boolean;
+begin
+  Result := FTerminated;
+end;
+
+function TListedThread.GetThreadId: Integer;
+begin
+  Result := FThread.ThreadID;
+end;
+
+procedure TListedThread.SetFreeOnTerminate(const AValue: Boolean);
+begin
+  FThread.FreeOnTerminate := AValue;
+end;
+
+procedure TListedThread.SetPriority(const AValue: TThreadPriority);
+begin
+  FThread.Priority := AValue;
+end;
+
+procedure TListedThread.SetSuspended(const AValue: Boolean);
+begin
+  FThread.Suspended := AValue;
+end;
+
+procedure TListedThread.SetTerminated(const AValue: Boolean);
+begin
+  FTerminated := AValue;
+  if AValue then FThread.Terminate;
+end;
 
 constructor TListedThread.Create(CreateSuspended: Boolean;
   const StackSize: SizeUInt);
 begin
-  inherited;
+  FThread := TListedThreadExecute.Create(True, StackSize);
+  FThread.Parent := Self;
   try
     ThreadListLock.Acquire;
@@ -94 +243 @@
     ThreadListLock.Release;
   end;
+  if CreateSuspended = False then FThread.Start;
 end;
 
@@ -109 +259 @@
     ThreadListLock.Release;
   end;
+  FThread.Free;
   inherited Destroy;
 end;
@@ -123 +274 @@
     SysUtils.Sleep(Quantum);
   end;
+end;
+
+procedure TListedThread.Execute;
+begin
+end;
+
+procedure TListedThread.Resume;
+begin
+  FThread.Resume;
+end;
+
+procedure TListedThread.Suspend;
+begin
+  FThread.Suspend;
+end;
+
+procedure TListedThread.Start;
+begin
+  FThread.Start;
+end;
+
+procedure TListedThread.Terminate;
+begin
+  FTerminated := True;
+  FThread.Terminate;
+end;
+
+procedure TListedThread.Synchronize(AMethod: TThreadMethod);
+begin
+  FThread.Synchronize(FThread, AMethod);
+end;
+
+procedure TListedThread.WaitFor;
+begin
+  FThread.WaitFor;
 end;
 
@@ -142 +328 @@
 
 ThreadListLock := TCriticalSection.Create;
-ThreadList := TObjectList.Create;
-ThreadList.OwnsObjects := False;
+ThreadList := TThreadList.Create;
 
 finalization