Changeset 162 for MicroThreading/UMicroThreading.pas

Timestamp:

Feb 7, 2011, 1:04:27 PM (13 years ago)

Author:

george

Message:

• Add: MicroThread critical section.
• Add: Thread list to microthread list window.

File:

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

MicroThreading/UMicroThreading.pas

@@ -1 @@
-(* Not implemented yet
+// Date: 2010-02-07
+
+(*
+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
+- wait for multiple objects
+- micro thread priority
 *)
 
@@ -31 +33 @@
   SCantDetermineThreadID = 'Can''t determine thread for id %d';
   SNotInThread = 'Not in thread';
+  SReleaseNotAcquiredLock = 'Release not acquired lock';
 
 
@@ -41 +44 @@
   TMicroThreadBlockState = (tbsNone, tbsSleeping, tbsWaitFor, tbsTerminating,
     tbsTerminated);
+
+  { TMicroThreadCriticalSection }
+
+  TMicroThreadCriticalSection = class
+    Lock: TCriticalSection;
+    Counter: Integer;
+    procedure Acquire;
+    procedure Release;
+    constructor Create;
+    destructor Destroy; override;
+  end;
 
   { TMicroThreadEvent }
@@ -53 +67 @@
     procedure SetEvent;
     procedure ResetEvent;
-    procedure WaitFor(Duration: TDateTime);
+    function WaitFor(Duration: TDateTime): TWaitResult;
     constructor Create;
     destructor Destroy; override;
@@ -70 +84 @@
     FExecutionCount: Integer;
     FStack: Pointer;
-    FStackPointer: Pointer;
+    FStackPointer: Pointer; // Register SP
     FStackSize: Integer;
-    FBasePointer: Pointer;
+    FBasePointer: Pointer; // Register BP
     FExceptObjectStack: PExceptObject;
     FExceptAddrStack: PExceptAddr;
@@ -160 +174 @@
     FThread: TMicroThreadThread;
     FId: Integer;
+    FLoopDuration: TDateTime;
+    FLoopStart: TDateTime;
     procedure SetCurrentMicroThread(const AValue: TMicroThread);
     function Execute(Count: Integer): Integer;
@@ -170 +186 @@
     destructor Destroy; override;
     property Scheduler: TMicroThreadScheduler read FScheduler;
+    property LoopDuration: TDateTime read FLoopDuration;
+    function GetCurrentMicroThreadId: Integer;
   end;
 
@@ -206 +224 @@
     procedure MainThreadTick(Data: PtrInt);
   public
+    BurstCount: Integer;
     function Add(MicroThread: TMicroThread): Integer;
     function AddMethod(Method: TMicroThreadMethod): Integer;
@@ -343 +362 @@
 end;
 
+{ TMicroThreadCriticalSection }
+
+procedure TMicroThreadCriticalSection.Acquire;
+begin
+  try
+    Lock.Acquire;
+    while Counter > 0 do begin
+      try
+        Lock.Release;
+        MTSleep(1 * OneMillisecond);
+      finally
+        Lock.Acquire;
+      end;
+    end;
+    Inc(Counter);
+  finally
+    Lock.Release;
+  end;
+end;
+
+procedure TMicroThreadCriticalSection.Release;
+begin
+  try
+    Lock.Acquire;
+    if Counter > 0 then Dec(Counter)
+      else raise Exception.Create(SReleaseNotAcquiredLock);
+  finally
+    Lock.Release;
+  end;
+end;
+
+constructor TMicroThreadCriticalSection.Create;
+begin
+  Lock := TCriticalSection.Create;
+end;
+
+destructor TMicroThreadCriticalSection.Destroy;
+begin
+  Acquire;
+  Lock.Free;
+  inherited Destroy;
+end;
+
 { TMicroThreadList }
 
@@ -363 +425 @@
     for I := 0 to FMicroThreads.Count - 1 do
     with TMicroThread(FMicroThreads[I]) do begin
-      if (FState = tsBlocked) and (FBlockState = tbsWaitFor) then
+      if (FState = tsBlocked) and (FBlockState = tbsWaitFor) then begin
         FState := tsWaiting;
+        FBlockTime := 0; // Set signaled state using block time variable
+      end;
     end;
     if not FAutoReset then FSignaled := True;
@@ -377 +441 @@
 end;
 
-procedure TMicroThreadEvent.WaitFor(Duration: TDateTime);
+function TMicroThreadEvent.WaitFor(Duration: TDateTime): TWaitResult;
 var
   MT: TMicroThread;
 begin
   MT := GetCurrentMicroThread;
-  if Assigned(MT) then MT.WaitForEvent(Self, Duration);
+  if Assigned(MT) then Result := MT.WaitForEvent(Self, Duration)
+    else Result := wrSignaled;
 end;
 
@@ -422 +487 @@
 function TMicroThreadManager.Execute(Count: Integer): Integer;
 begin
+  FLoopStart := NowPrecise;
   FStack := StackBottom;
   FStackSize := StackBottom + StackLength;
@@ -428 +494 @@
   Yield;
   Result := FExecutedCount;
+  FLoopDuration := NowPrecise - FLoopStart;
 end;
 
@@ -489 +556 @@
           mov ebp, ebx
           // We want to call virtual method Execute
-          // but virtual methods can be called only statically
+          // but methods can be called only statically from assembler
           // Then static method CallExecute is calling virtual method Execute
           call TMicroThread.CallExecute
@@ -515 +582 @@
             FMicroThreadsLock.Acquire;
             FMicroThreads.Delete(FMicroThreads.IndexOf(FCurrentMicroThread));
-            FCurrentMicroThread.Manager := nil;
+            FCurrentMicroThread := nil;
           finally
             FMicroThreadsLock.Release;
@@ -562 +629 @@
 end;
 
+function TMicroThreadManager.GetCurrentMicroThreadId: Integer;
+begin
+  try
+    FScheduler.FMicroThreadsLock.Acquire;
+    if Assigned(FCurrentMicroThread) then
+      Result := FCurrentMicroThread.Id
+      else Result := 0;
+  finally
+    FScheduler.FMicroThreadsLock.Release;
+  end;
+end;
+
 { TMicroThreadThread }
 
@@ -571 +650 @@
     repeat
       State := ttsRunning;
-      ExecutedCount := Manager.Execute(10);
+      ExecutedCount := Manager.Execute(MainScheduler.BurstCount);
       State := ttsReady;
       if ExecutedCount = 0 then Sleep(1);
@@ -691 +770 @@
   end;
   Yield;
-  if FBlockTime < NowPrecise then
-    Result := wrTimeout else Result := wrSignaled;
+  if (FBlockTime <> 0) and (FBlockTime < NowPrecise) then Result := wrTimeout
+    else Result := wrSignaled;
 
   try
@@ -811 +890 @@
   FMainThreadManager.FScheduler := Self;
   UseMainThread := False;
+  BurstCount := 100;
 end;
 
@@ -900 +980 @@
 var
   Executed: Integer;
+  StartTime: TDateTime;
+  Duration: TDateTime;
 begin
 //  try
-    Executed := FMainThreadManager.Execute(1);
-    if Executed = 0 then Sleep(1);
+    Duration := 100 * OneMillisecond;
+    StartTime := NowPrecise;
+    Executed := -1;
+    while (Executed <> 0) and ((NowPrecise - StartTime) < Duration) do begin
+      Executed := FMainThreadManager.Execute(BurstCount);
+    end;
+    //if Executed = 0 then Sleep(1);
     // If not terminated then queue next tick else terminate
     if (FState = ssRunning) and FUseMainThread then