Changeset 149 for MicroThreading/UMicroThreading.pas

Timestamp:

Jan 26, 2011, 7:12:08 PM (14 years ago)

Author:

george

Message:

• Moved: Global function with platform depending implementation moved to UPlatform unit.
• Modifed: Demo form restructuralized to tabs with separate pages.

File:

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

MicroThreading/UMicroThreading.pas

@@ +1 @@
+(* Not implemented yet
+- Stack limit checking
+- measurement of cpu usage by micro threads
+- microthread critical sections (no low level cpu blocking)
+- wait for single and multiple objects
+- micro thread priorty
+*)
+
 unit UMicroThreading;
 
@@ -7 +15 @@
 
 uses
-  {$IFDEF Windows}Windows,{$ENDIF}
-  {$IFDEF Linux}BaseUnix, UnixUtil, Unix,{$ENDIF}
-  Classes, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms;
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms, UPlatform;
 
 const
@@ -43 +52 @@
     FManager: TMicroThreadManager;
     FId: Integer;
+    function GetStackUsed: Integer;
   public
     Name: string;
@@ -69 +79 @@
     property Scheduler: TMicroThreadScheduler read FScheduler;
     property Manager: TMicroThreadManager read FManager;
+    property StackUsed: Integer read GetStackUsed;
   end;
 
@@ -80 +91 @@
   end;
 
-  { TMicroThreadSchedulerPoolThread }
-
-  TMicroThreadSchedulerPoolThread = class(TThread)
+  { TMicroThreadThread }
+
+  TMicroThreadThread = class(TThread)
     Manager: TMicroThreadManager;
     procedure Execute; override;
@@ -88 +99 @@
       const StackSize: SizeUInt = DefaultStackSize);
     destructor Destroy; override;
-  end;
-
-  TThreadPool = class(TObjectList)
   end;
 
@@ -123 +131 @@
   private
     FActive: Boolean;
-    FThreadPool: TThreadPool;
+    FThreadPool: TObjectList;
     FThreadPoolLock: TCriticalSection;
     FThreadPoolSize: Integer;
@@ -129 +137 @@
     FLastId: Integer;
     FFrequency: Int64;
-    FTerminate: Boolean;
     FTerminated: Boolean;
     FMicroThreads: TObjectList; // TList<TMicroThread>
@@ -136 +143 @@
     FState: TMicroThreadSchedulerState;
     function GetMicroThreadCount: Integer;
+    function GetThreadPoolCount: Integer;
     function GetThreadPoolSize: Integer;
     procedure SetActive(const AValue: Boolean);
     procedure SetThreadPoolSize(const AValue: Integer);
     function GetNextMicroThread: TMicroThread;
-    procedure WaitFor;
     procedure Start;
     procedure Stop;
-    function ThreadPoolTerminated: Boolean;
+    procedure PoolThreadTerminated(Sender: TObject);
+    procedure UpdateThreadPoolSize;
   public
-    function GetNow: TDateTime;
     function Add(MicroThread: TMicroThread): Integer;
     function AddMethod(Method: TMicroThreadEvent): Integer;
-    function GetCPUCoreCount: Integer;
     constructor Create;
     destructor Destroy; override;
-    property MicroThreadCount: Integer read GetMicroThreadCount;
+    property ThreadPool: TObjectList read FThreadPool;
     property ThreadPoolSize: Integer read GetThreadPoolSize
       write SetThreadPoolSize;
+    property ThreadPoolCount: Integer read GetThreadPoolCount;
     property MicroThreads: TObjectList read FMicroThreads;
     property MicroThreadsLock: TCriticalSection read FMicroThreadsLock;
+    property MicroThreadCount: Integer read GetMicroThreadCount;
     property MainThreadManager: TMicroThreadManager read FMainThreadManager;
     property Active: Boolean read FActive write SetActive;
@@ -216 +224 @@
   CurrentTime: TDateTime;
 begin
-  CurrentTime := FScheduler.GetNow;
+  CurrentTime := NowPrecise;
   if Assigned(FCurrentMicroThread) then begin
     FCurrentMicroThread.FExecutionEndTime := CurrentTime;
@@ -268 +276 @@
         mov edx, [eax].TMicroThread.FStackPointer
         mov esp, edx
-        push ebp
+        push ebp // remember bp on micro thread stack for read back
         mov edx, [eax].TMicroThread.FBasePointer
         mov ebp, edx
@@ -336 +344 @@
 end;
 
-{ TMicroThreadSchedulerPoolThread }
-
-procedure TMicroThreadSchedulerPoolThread.Execute;
+{ TMicroThreadThread }
+
+procedure TMicroThreadThread.Execute;
 var
   ExecutedCount: Integer;
@@ -354 +362 @@
 end;
 
-constructor TMicroThreadSchedulerPoolThread.Create(CreateSuspended: Boolean;
+constructor TMicroThreadThread.Create(CreateSuspended: Boolean;
   const StackSize: SizeUInt);
 begin
@@ -361 +369 @@
 end;
 
-destructor TMicroThreadSchedulerPoolThread.Destroy;
+destructor TMicroThreadThread.Destroy;
 begin
   Manager.Free;
@@ -377 +385 @@
 
 { TMicroThread }
+
+function TMicroThread.GetStackUsed: Integer;
+begin
+  Result := FStack + FStackSize - FStackPointer;
+end;
 
 procedure TMicroThread.Execute;
@@ -398 +411 @@
 procedure TMicroThread.Sleep(Duration: TDateTime);
 begin
-  FWakeUpTime := FScheduler.GetNow + Duration;
+  FWakeUpTime := NowPrecise + Duration;
   FState := tsSleeping;
   Yield;
@@ -461 +474 @@
 { TMicroThreadScheduler }
 
-function TMicroThreadScheduler.GetNow: TDateTime;
-var
-  {$IFDEF Linux}T: TimeVal;{$ENDIF}
-  {$IFDEF Windows}TimerValue: Int64;{$ENDIF}
-begin
-  {$IFDEF Windows}
-  QueryPerformanceCounter(TimerValue);
-  //Result := Int64(TimeStampToMSecs(DateTimeToTimeStamp(Now)) * 1000) // an alternative Win32 timebase
-  Result := TimerValue / FFrequency;
-  {$ENDIF}
-
-  {$IFDEF Linux}
-  fpgettimeofday(@t, nil);
-   // Build a 64 bit microsecond tick from the seconds and microsecond longints
-  Result := t.tv_sec + t.tv_usec / 1000000;
-  {$ENDIF}
-
-  Result := (Trunc(Now / OneSecond) + Frac(Result)) * OneSecond;
-end;
-
 function TMicroThreadScheduler.Add(MicroThread: TMicroThread): Integer;
 begin
@@ -486 +479 @@
   MicroThread.FScheduler := Self;
   MicroThread.FId := FLastId;
-  Result := FMicroThreads.Add(MicroThread);
+  try
+    FMicroThreadsLock.Acquire;
+    Result := FMicroThreads.Add(MicroThread);
+  finally
+    FMicroThreadsLock.Release;
+  end;
 end;
 
@@ -499 +497 @@
 end;
 
-function TMicroThreadScheduler.GetCPUCoreCount: Integer;
-var
-  SystemInfo: _SYSTEM_INFO;
-begin
-  GetSystemInfo(SystemInfo);
-  Result := SystemInfo.dwNumberOfProcessors;
-end;
-
 constructor TMicroThreadScheduler.Create;
 begin
@@ -512 +502 @@
   FMicroThreadsLock := TCriticalSection.Create;
   FMicroThreads := TObjectList.Create;
-  FThreadPool := TThreadPool.Create;
+  FThreadPool := TObjectList.Create;
   FThreadPoolLock := TCriticalSection.Create;
-  {$IFDEF Windows}
-  QueryPerformanceFrequency(FFrequency);
-  {$ENDIF}
   FRoundRobinIndex := -1;
   FMainThreadManager := TMicroThreadManager.Create;
@@ -538 +525 @@
 begin
   FTerminated := False;
-  FTerminate := False;
-  for I := 0 to FThreadPool.Count - 1 do
-    TMicroThreadSchedulerPoolThread(FThreadPool[I]).Start;
+  UpdateThreadPoolSize;
+  FState := ssRunning;
   repeat
     Executed := FMainThreadManager.Execute(10);
     Application.ProcessMessages;
     if Executed = 0 then Sleep(1);
-  until FTerminate;
+  until FState <> ssRunning;
   FTerminated := True;
 end;
@@ -553 +539 @@
   I: Integer;
 begin
+  FState := ssTerminating;
   try
     FThreadPoolLock.Acquire;
     for I := 0 to FThreadPool.Count - 1 do begin
-      TMicroThreadSchedulerPoolThread(FThreadPool[I]).Terminate;
+      TMicroThreadThread(FThreadPool[I]).Terminate;
     end;
   finally
     FThreadPoolLock.Release;
   end;
-  FTerminate := True;
 
   // Wait for all thread managers to finish
@@ -568 +554 @@
     Sleep(1);
   until FTerminated and (ThreadPoolSize = 0);
-end;
-
-function TMicroThreadScheduler.ThreadPoolTerminated: Boolean;
-var
-  I: Integer;
+  FState := ssStopped;
+end;
+
+procedure TMicroThreadScheduler.PoolThreadTerminated(Sender: TObject);
 begin
   try
     FThreadPoolLock.Acquire;
-    I := 0;
-    while (I < FThreadPool.Count) and
-      (TMicroThreadSchedulerPoolThread(FThreadPool[I]).Terminated do
+    FThreadPool.Delete(FThreadPool.IndexOf(Sender));
   finally
     FThreadPoolLock.Release;
@@ -584 +567 @@
 end;
 
+procedure TMicroThreadScheduler.UpdateThreadPoolSize;
+var
+  NewThread: TMicroThreadThread;
+begin
+  try
+    FThreadPoolLock.Acquire;
+    if FThreadPoolSize > FThreadPool.Count then begin
+      FThreadPool.Capacity := FThreadPoolSize;
+      while FThreadPool.Count < FThreadPoolSize do begin
+        NewThread := TMicroThreadThread.Create(True);
+        NewThread.Manager.FScheduler := Self;
+        NewThread.OnTerminate := PoolThreadTerminated;
+        ThreadPool.Add(NewThread);
+        NewThread.Resume;
+      end;
+    end else
+    ThreadPool.Count := FThreadPoolSize;
+  finally
+    FThreadPoolLock.Release;
+  end;
+end;
+
 function TMicroThreadScheduler.GetNextMicroThread: TMicroThread;
 var
@@ -589 +594 @@
   CurrentTime: TDateTime;
 begin
-  CurrentTime := GetNow;
+  CurrentTime := NowPrecise;
   Result := nil;
   try
@@ -629 +634 @@
 end;
 
+function TMicroThreadScheduler.GetThreadPoolCount: Integer;
+begin
+  try
+    FThreadPoolLock.Acquire;
+    Result := FThreadPool.Count;
+  finally
+    FThreadPoolLock.Release;
+  end;
+end;
+
 function TMicroThreadScheduler.GetThreadPoolSize: Integer;
 begin
@@ -645 +660 @@
 var
   I: Integer;
-  NewThread: TMicroThreadSchedulerPoolThread;
+  NewThread: TMicroThreadThread;
 begin
   FThreadPoolSize := AValue;
   if FState = ssRunning then
-    SetThreadPoolCount
+    UpdateThreadPoolSize;
 end;