Changeset 159 for MicroThreading/UMicroThreading.pas

Timestamp:

Jan 31, 2011, 2:16:21 PM (13 years ago)

Author:

george

Message:

• Added: Running microthread list window.
• Modified: Main thread is executed by application queued async call.

File:

• MicroThreading/UMicroThreading.pas (modified) (17 diffs)

MicroThreading/UMicroThreading.pas

@@ -18 +18 @@
   cthreads,
   {$ENDIF}{$ENDIF}
-  Classes, ExtCtrls, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms, UPlatform;
+  Classes, ExtCtrls, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms,
+  UPlatform, UMicroThreadList;
 
 const
-  DefaultStackSize = $4000;
+  DefaultStackSize = $40000;
 
 type
@@ -191 +192 @@
     procedure UpdateThreadPoolSize;
     procedure MainThreadStart(Sender: TObject);
+    procedure MainThreadTick(Data: PtrInt);
   public
     function Add(MicroThread: TMicroThread): Integer;
     function AddMethod(Method: TMicroThreadMethod): Integer;
-    procedure Remove(MicroThread: TMicroThread);
+    function FindCurrentThread: TThread;
+    procedure Remove(MicroThread: TMicroThread; Free: Boolean = True);
     constructor Create;
     destructor Destroy; override;
@@ -210 +213 @@
   end;
 
+  TMicroThreadList = class(TComponent)
+  private
+  public
+    Form: TMicroThreadListForm;
+    constructor Create(AOwner: TComponent);
+  end;
+
+  TMicroThreadExceptionEvent = procedure(Sender: TObject; E: Exception) of object;
+
 var
   MainScheduler: TMicroThreadScheduler;
+  ExceptionHandler: TMicroThreadExceptionEvent;
 
 const
@@ -223 +236 @@
 function GetCurrentMicroThread: TMicroThread;
 procedure MTSleep(Duration: TDateTime);
+procedure MTSynchronize(Method: TThreadMethod);
 function MTWaitForEvent(Event: TMicroThreadEvent; Duration: TDateTime): TWaitResult;
 procedure Log(Text: string);
+procedure Register;
 
 const
@@ -235 +250 @@
 //  StaticManager: TMicroThreadManager;
 //  StaticMicroThread: TMicroThread;
+
+procedure Register;
+begin
+  RegisterComponents('MicroThreading', [TMicroThreadList]);
+end;
 
 function GetMicroThreadId: Integer;
@@ -267 +287 @@
   with MainScheduler do
   try
-    FThreadPoolLock.Acquire;
+    FMicroThreadsLock.Acquire;
     if MainThreadID = ThreadID then Result := MainThreadManager.CurrentMicroThread
-    else begin
-      I := 0;
-      while (I < FThreadPool.Count) and (TMicroThreadThread(FThreadPool[I]).ThreadID <> ThreadID) do Inc(I);
-      if I < FThreadPool.Count then Result := TMicroThreadThread(FThreadPool[I]).Manager.CurrentMicroThread
-        else Result := nil;
-    end;
-  finally
-    FThreadPoolLock.Release;
+      else Result := TMicroThreadThread(MainScheduler.FindCurrentThread).Manager.CurrentMicroThread;
+  finally
+    FMicroThreadsLock.Release;
   end;
 end;
@@ -289 +304 @@
 end;
 
+procedure MTSynchronize(Method: TThreadMethod);
+var
+  Thread: TThread;
+begin
+  if GetCurrentThreadId <> MainThreadID then begin
+    Thread := MainScheduler.FindCurrentThread;
+    if Assigned(Thread) then TThread.Synchronize(Thread, Method)
+      else raise Exception.Create('Can''t determine thread for id ' + IntToStr(GetCurrentThreadId));
+  end else Method;
+end;
+
 function MTWaitForEvent(Event: TMicroThreadEvent; Duration: TDateTime): TWaitResult;
 var
@@ -294 +320 @@
 begin
   MT := GetCurrentMicroThread;
-  if Assigned(MT) then Result := MT.WaitForEvent(Event, Duration);
+  if Assigned(MT) then Result := MT.WaitForEvent(Event, Duration)
+    else raise Exception.Create('Not in thread');
 //    else Result := Event.WaitFor(Trunc(Duration / OneMillisecond));
 end;
@@ -316 +343 @@
   end;
 end;
+
+{ TMicroThreadList }
+
+constructor TMicroThreadList.Create(AOwner: TComponent);
+begin
+  inherited;
+  Form := TMicroThreadListForm.Create(Self);
+end;
+
+
 
 { TMicroThreadMethod }
@@ -360 +397 @@
 destructor TMicroThreadEvent.Destroy;
 begin
-  MainScheduler.FEvents.Delete(MainScheduler.FEvents.IndexOf(Self));
+  try
+    MainScheduler.FEvents.OwnsObjects := False;
+    MainScheduler.FEvents.Delete(MainScheduler.FEvents.IndexOf(Self));
+  finally
+    MainScheduler.FEvents.OwnsObjects := True;
+  end;
   FMicroThreadsLock.Free;
   FMicroThreads.Free;
@@ -441 +483 @@
           // but virtual methods can be called only statically
           // Then static method CallExecute is calling virtual method Execute
-          call TMicroThread.CallExecute
+            call TMicroThread.CallExecute
 
           // Restore manager stack
@@ -522 +564 @@
     until Terminated;
   except
-    on E: Exception do ;
-      //ExceptionHandler(E);
+    on E: Exception do
+      if Assigned(ExceptionHandler) then ExceptionHandler(Self, E);
   end;
 end;
@@ -549 +591 @@
 end;
 
-
 { TMicroThread }
 
 procedure TMicroThread.CallExecute;
 begin
-  Execute;
+  try
+    Execute;
+  except
+    on E: Exception do
+      ExceptionHandler(Self, E);
+  end;
   asm
     mov ecx, Self
@@ -631 +677 @@
   end;
   Yield;
+  if FBlockTime < NowPrecise then
+    Result := wrTimeout else Result := wrSignaled;
+
   try
     Event.FMicroThreadsLock.Acquire;
@@ -669 +718 @@
 destructor TMicroThread.Destroy;
 begin
+  MainScheduler.Remove(Self, False);
   //Terminate;
   //WaitFor;
@@ -718 +768 @@
 end;
 
-procedure TMicroThreadScheduler.Remove(MicroThread: TMicroThread);
+function TMicroThreadScheduler.FindCurrentThread: TThread;
+var
+  I: Integer;
+begin
+  try
+    FThreadPoolLock.Acquire;
+    I := 0;
+    while (I < FThreadPool.Count) and (TMicroThreadThread(FThreadPool[I]).ThreadID <> ThreadID) do Inc(I);
+    if I < FThreadPool.Count then Result := TMicroThreadThread(FThreadPool[I])
+      else Result := nil;
+  finally
+    FThreadPoolLock.Release;
+  end;
+end;
+
+procedure TMicroThreadScheduler.Remove(MicroThread: TMicroThread;
+  Free: Boolean = True);
 begin
   try
     FMicroThreadsLock.Acquire;
+    if not Free then FMicroThreads.OwnsObjects := False;
     FMicroThreads.Remove(MicroThread);
+    FMicroThreads.OwnsObjects := True;
   finally
     FMicroThreadsLock.Release;
@@ -824 +892 @@
 
 procedure TMicroThreadScheduler.MainThreadStart(Sender: TObject);
-var
-  Executed: Integer;
 begin
   FMainThreadStarter.Enabled := False;
   FMainThreadTerminated := False;
-  repeat
-    Executed := FMainThreadManager.Execute(1);
-    Application.ProcessMessages;
-    if Executed = 0 then Sleep(1);
-  until (FState <> ssRunning) or (not FUseMainThread);
-  FMainThreadTerminated := True;
+  Application.QueueAsyncCall(MainThreadTick, 0);
+end;
+
+procedure TMicroThreadScheduler.MainThreadTick(Data: PtrInt);
+var
+  Executed: Integer;
+begin
+  Executed := FMainThreadManager.Execute(1);
+  if Executed = 0 then Sleep(1);
+  // If not terminated then queue next tick else terminate
+  if (FState = ssRunning) and FUseMainThread then
+    Application.QueueAsyncCall(MainThreadTick, 0)
+    else FMainThreadTerminated := True;
 end;