Changeset 142 for MicroThreading/UMicroThreading.pas

Timestamp:

Jan 24, 2011, 4:02:40 PM (14 years ago)

Author:

george

Message:

• Added: Global scheduler MainScheduler for direct access.
• Added: Similar thread construction as TThread class where Execute is virtual method. Direct adding of method is supported as well.

File:

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

MicroThreading/UMicroThreading.pas

@@ -11 +11 @@
   Classes, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms;
 
+const
+  DefaultStackSize = $4000;
+
 type
   TMicroThread = class;
   TMicroThreadScheduler = class;
 
-  TStartEvent = procedure(MicroThread: TMicroThread) of object;
-
-  TMicroThreadState = (tsReady, tsRunning, tsWaiting, tsBlocked, tsSuspended,
-    tsSleeping, tsFinished);
+  TMicroThreadState = (tsWaiting, tsRunning, tsBlocked, tsSuspended,
+    tsSleeping);
+
 
   { TMicroThread }
@@ -24 +26 @@
   TMicroThread = class
   private
-    FMethod: TStartEvent;
+    FFreeOnTerminate: Boolean;
     FStack: Pointer;
     FStackSize: Integer;
@@ -33 +35 @@
     FBasePointer: Pointer;
     FWakeupTime: TDateTime;
+    FTerminated: Boolean;
+    FExecuted: Boolean; // At first go through Execute method, then switch context
+    FFinished: Boolean;
   public
     Id: Integer;
@@ -39 +44 @@
     State: TMicroThreadState;
     Scheduler: TMicroThreadScheduler;
+    procedure Execute; virtual;
+
+    // Internal execution
     procedure Yield;
     procedure Sleep(Duration: TDateTime);
-    constructor Create;
+    function WaitForSignal(Signal: TEvent): TWaitResult;
+
+    // External execution
+    procedure WaitFor;
+    procedure Terminate;
+    procedure Start;
+    procedure Stop;
+
+    constructor Create(CreateSuspended: Boolean;
+      const StackSize: SizeUInt = DefaultStackSize);
     destructor Destroy; override;
-    property Method: TStartEvent read FMethod write FMethod;
     property ExecutionTime: TDateTime read FExecutionTime;
+    property FreeOnTerminate: Boolean read FFreeOnTerminate
+      write FFreeOnTerminate;
+    property Terminated: Boolean read FTerminated;
+  end;
+
+  TMicroThreadEvent = procedure(MicroThread: TMicroThread) of object;
+
+  { TMicroThreadMethod }
+
+  TMicroThreadMethod = class(TMicroThread)
+    Method: TMicroThreadEvent;
+    procedure Execute; override;
   end;
 
@@ -55 +83 @@
   TMicroThreadScheduler = class
   private
-    FFreeMicroThreadOnFinish: Boolean;
     ThreadPool: TThreadPool;
     RoundRobinIndex: Integer;
@@ -67 +94 @@
     FExecutedCount: Integer;
     FTerminated: Boolean;
+    FThreadPoolSize: Integer;
     function GetMicroThreadCount: Integer;
+    function GetThreadPoolSize: Integer;
+    procedure SetThreadPoolSize(const AValue: Integer);
     procedure Yield(MicroThread: TMicroThread);
   public
     MicroThreads: TObjectList; // TList<TMicroThread>
     Lock: TCriticalSection;
+    CurrentMicroThread: TMicroThread;
     function GetNow: TDateTime;
-    function Add(Name: string; Method: TStartEvent): TMicroThread;
+    function Add(MicroThread: TMicroThread): Integer;
+    function AddMethod(Method: TMicroThreadEvent): Integer;
     constructor Create;
     destructor Destroy; override;
@@ -80 +112 @@
     procedure Stop;
     property MicroThreadCount: Integer read GetMicroThreadCount;
-    property FreeMicroThreadOnFinish: Boolean read FFreeMicroThreadOnFinish
-      write FFreeMicroThreadOnFinish;
-  end;
+    property ThreadPoolSize: Integer read GetThreadPoolSize
+      write SetThreadPoolSize;
+  end;
+
+var
+  MainScheduler: TMicroThreadScheduler;
 
 const
-  MicroThreadStateText: array[TMicroThreadState] of string = ('Ready', 'Running',
-    'Waiting', 'Blocked', 'Suspended', 'Sleeping', 'Finished');
+  MicroThreadStateText: array[TMicroThreadState] of string = ('Waiting',
+    'Running', 'Blocked', 'Suspended', 'Sleeping');
 
 implementation
 
+{ TMicroThreadMethod }
+
+procedure TMicroThreadMethod.Execute;
+begin
+  inherited Execute;
+  Method(Self);
+end;
+
 
 { TMicroThread }
 
+procedure TMicroThread.Execute;
+begin
+
+end;
+
 procedure TMicroThread.Yield;
 begin
   Scheduler.Yield(Self);
+end;
+
+procedure TMicroThread.WaitFor;
+begin
+  while not FFinished do begin
+    Sleep(1);
+  end;
 end;
 
@@ -105 +160 @@
 end;
 
-constructor TMicroThread.Create;
-begin
-  FStackSize := $10000;
+function TMicroThread.WaitForSignal(Signal: TEvent): TWaitResult;
+begin
+  repeat
+    Result := Signal.WaitFor(1);
+    Sleep(1);
+  until Result <> wrTimeout;
+end;
+
+constructor TMicroThread.Create(CreateSuspended: Boolean;
+  const StackSize: SizeUInt = DefaultStackSize);
+begin
+  FStackSize := StackSize;
   FStack := GetMem(FStackSize);
   FBasePointer := FStack + FStackSize;
   FStackPointer := FBasePointer - 20;
   FExecutionTime := 0;
+  FTerminated := False;
+  if CreateSuspended then
+    State := tsSuspended;
+  FFreeOnTerminate := True;
+end;
+
+procedure TMicroThread.Terminate;
+begin
+  FTerminated := True;
 end;
 
 destructor TMicroThread.Destroy;
 begin
+  Terminate;
+  WaitFor;
+  // Microthread is finished, remove it from queue
+  try
+    Scheduler.Lock.Acquire;
+    Scheduler.MicroThreads.Delete(Scheduler.MicroThreads.IndexOf(Self));
+  finally
+    Scheduler.Lock.Release;
+  end;
   FreeMem(FStack);
   inherited Destroy;
+end;
+
+procedure TMicroThread.Start;
+begin
+  State := tsWaiting;
+end;
+
+procedure TMicroThread.Stop;
+begin
+  State := tsSuspended;
 end;
 
@@ -142 +234 @@
 end;
 
-function TMicroThreadScheduler.Add(Name: string; Method: TStartEvent
-  ): TMicroThread;
-var
-  NewMicroThread: TMicroThread;
-begin
-  NewMicroThread := TMicroThread.Create;
+function TMicroThreadScheduler.Add(MicroThread: TMicroThread): Integer;
+begin
+  Inc(LastId);
+  MicroThread.Scheduler := Self;
+  MicroThread.Id := LastId;
+  Result := MicroThreads.Add(MicroThread);
+end;
+
+function TMicroThreadScheduler.AddMethod(Method: TMicroThreadEvent): Integer;
+var
+  NewMicroThread: TMicroThreadMethod;
+begin
+  NewMicroThread := TMicroThreadMethod.Create(False);
+  NewMicroThread.Method := Method;
   NewMicroThread.Scheduler := Self;
-  NewMicroThread.Name := Name;
-  NewMicroThread.Method := Method;
-  Inc(LastId);
-  NewMicroThread.Id := LastId;
-  MicroThreads.Add(NewMicroThread);
+  Result := Add(NewMicroThread);
 end;
 
@@ -161 +257 @@
   MicroThreads := TObjectList.Create;
   ThreadPool := TThreadPool.Create;
-  FFreeMicroThreadOnFinish := True;
   {$IFDEF Windows}
   QueryPerformanceFrequency(FFrequency);
@@ -235 +330 @@
       mov ebp, edx
     end;
+    CurrentMicroThread := nil;
   end;
 
@@ -245 +341 @@
     if RoundRobinIndex >= MicroThreads.Count then
       RoundRobinIndex := 0;
-    while (I < MicroThreads.Count) and (TMicroThread(MicroThreads[RoundRobinIndex]).State <> tsReady) and
-(TMicroThread(MicroThreads[RoundRobinIndex]).State <> tsWaiting) do begin
+    while (I < MicroThreads.Count) and
+     (TMicroThread(MicroThreads[RoundRobinIndex]).State <> tsWaiting) do begin
       // WakeUp sleeping threads
       if (TMicroThread(MicroThreads[RoundRobinIndex]).State = tsSleeping) and
@@ -268 +364 @@
   if Assigned(FSelected) and (FExecutedCount < FExecuteCount) then begin
     Inc(FExecutedCount);
+    CurrentMicroThread := FSelected;
     asm
       // Store scheduler stack
@@ -276 +373 @@
       mov [eax].TMicroThreadScheduler.FMainBasePointer, edx
     end;
-    if FSelected.State = tsReady then begin
+    if not FSelected.FExecuted then begin
+      FSelected.FExecuted := True;
       FSelected.State := tsRunning;
       FSelected.FExecutionStartTime := Time;
@@ -293 +391 @@
         mov ebp, edx
       end;
-      StaticMicroThread.Method(StaticMicroThread);
+      StaticMicroThread.Execute;
       //FSelected.Method(FSelected);
       StaticScheduler := StaticMicroThread.Scheduler;
@@ -307 +405 @@
       FSelected.FExecutionTime := FSelected.FExecutionTime +
        (FSelected.FExecutionEndTime - FSelected.FExecutionStartTime);
-      if FFreeMicroThreadOnFinish then begin
-        // Microthread is finished, remove it from queue
-        try
-          Lock.Acquire;
-          MicroThreads.Delete(MicroThreads.IndexOf(FSelected));
-        finally
-          Lock.Release;
-        end;
-      end else FSelected.State := tsFinished;
+      FSelected.FFinished := True;
+      if FSelected.FFreeOnTerminate then begin
+        FSelected.Free;
+      end;;
     end else
     if FSelected.State = tsWaiting then begin
@@ -348 +441 @@
 end;
 
+function TMicroThreadScheduler.GetThreadPoolSize: Integer;
+begin
+  Result := FThreadPoolSize;
+end;
+
+procedure TMicroThreadScheduler.SetThreadPoolSize(const AValue: Integer);
+begin
+  FThreadPoolSize := AValue;
+end;
+
+initialization
+
+MainScheduler := TMicroThreadScheduler.Create;
+
+finalization
+
+MainScheduler.Free;
+
 end.