Ignore:
Timestamp:
Jan 27, 2011, 2:15:57 PM (13 years ago)
Author:
george
Message:
  • Add: Not completed event signaling support.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • MicroThreading/UMicroThreading.pas

    r153 r154  
    3030  TMicroThreadState = (tsWaiting, tsRunning, tsBlocked, tsSuspended,
    3131    tsSleeping);
     32
     33  { TMicroThreadEvent }
     34
     35  TMicroThreadEvent = class
     36  private
     37    FAutoReset: Boolean;
     38    FSignaled: Boolean;
     39    FMicroThreads: TObjectList;
     40    FMicroThreadsLock: TCriticalSection;
     41  public
     42    procedure SetEvent;
     43    procedure ResetEvent;
     44    procedure WaitFor(Duration: TDateTime);
     45    constructor Create;
     46    destructor Destroy; override;
     47    property Signaled: Boolean read FSignaled;
     48    property AutoReset: Boolean read FAutoReset write FAutoReset;
     49  end;
    3250
    3351  { TMicroThread }
     
    4866    FFinished: Boolean;
    4967    FSuspended: Boolean;
     68    FBlocked: Boolean;
    5069    FState: TMicroThreadState;
    5170    FScheduler: TMicroThreadScheduler;
    5271    FManager: TMicroThreadManager;
    5372    FId: Integer;
     73    FBlockCondition: Boolean;
    5474    procedure CallExecute;
    5575    function GetStackUsed: Integer;
     
    5878    Name: string;
    5979    Priority: Integer;
    60     Completion: Single; // Can be used for progress information in range <0, 1>
     80    Completion: Single; // Can be used for progress information usually in range <0, 1>
    6181    procedure Execute; virtual;
    6282
    6383    procedure Yield;
    64     procedure Sleep(Duration: TDateTime);
    65     function WaitForSignal(Signal: TEvent): TWaitResult;
     84    procedure MTSleep(Duration: TDateTime); // No conflicting name to global Sleep procedure
     85    function WaitForEvent(Event: TMicroThreadEvent; Duration: TDateTime): TWaitResult;
    6686    procedure WaitFor;
    6787    procedure Terminate;
     
    86106  end;
    87107
    88   TMicroThreadEvent = procedure(MicroThread: TMicroThread) of object;
    89 
    90   { TMicroThreadMethod }
    91 
    92   TMicroThreadMethod = class(TMicroThread)
    93     Method: TMicroThreadEvent;
     108  TMicroThreadMethod = procedure(MicroThread: TMicroThread) of object;
     109
     110  { TMicroThreadSimple }
     111
     112  TMicroThreadSimple = class(TMicroThread)
     113    Method: TMicroThreadMethod;
    94114    procedure Execute; override;
    95115  end;
     
    166186  public
    167187    function Add(MicroThread: TMicroThread): Integer;
    168     function AddMethod(Method: TMicroThreadEvent): Integer;
     188    function AddMethod(Method: TMicroThreadMethod): Integer;
     189    procedure Remove(MicroThread: TMicroThread);
    169190    constructor Create;
    170191    destructor Destroy; override;
     
    187208  MicroThreadStateText: array[TMicroThreadState] of string = ('Waiting',
    188209    'Running', 'Blocked', 'Suspended', 'Sleeping');
     210
     211function GetCurrentMicroThread: TMicroThread;
     212procedure MTSleep(Duration: TDateTime);
     213function MTWaitForEvent(Event: TMicroThreadEvent; Duration: TDateTime): TWaitResult;
    189214
    190215implementation
     
    218243    end;
    219244  end;
     245end;
     246
     247function GetCurrentMicroThread: TMicroThread;
     248var
     249  I: Integer;
     250begin
     251  with MainScheduler do
     252  try
     253    FThreadPoolLock.Acquire;
     254    if MainThreadID = ThreadID then Result := MainThreadManager.CurrentMicroThread
     255    else begin
     256      I := 0;
     257      while (I < FThreadPool.Count) and (TMicroThreadThread(FThreadPool[I]).ThreadID <> ThreadID) do Inc(I);
     258      if I < FThreadPool.Count then Result := TMicroThreadThread(FThreadPool[I]).Manager.CurrentMicroThread
     259        else Result := nil;
     260    end;
     261  finally
     262    FThreadPoolLock.Release;
     263  end;
     264end;
     265
     266procedure MTSleep(Duration: TDateTime);
     267var
     268  MT: TMicroThread;
     269begin
     270  MT := GetCurrentMicroThread;
     271  if Assigned(MT) then MT.MTSleep(Duration)
     272    else Sleep(Trunc(Duration / OneMillisecond));
     273end;
     274
     275function MTWaitForEvent(Event: TMicroThreadEvent; Duration: TDateTime): TWaitResult;
     276var
     277  MT: TMicroThread;
     278begin
     279  MT := GetCurrentMicroThread;
     280  if Assigned(MT) then Result := MT.WaitForEvent(Event, Duration);
     281//    else Result := Event.WaitFor(Trunc(Duration / OneMillisecond));
     282end;
     283
     284{ TMicroThreadMethod }
     285
     286procedure TMicroThreadEvent.SetEvent;
     287var
     288  I: Integer;
     289begin
     290  for I := 0 to FMicroThreads.Count - 1 do
     291    TMicroThread(FMicroThreads[I]).FBlockCondition := True;
     292  if not FAutoReset then FSignaled := True;
     293end;
     294
     295procedure TMicroThreadEvent.ResetEvent;
     296begin
     297  FSignaled := False;
     298end;
     299
     300procedure TMicroThreadEvent.WaitFor(Duration: TDateTime);
     301var
     302  MT: TMicroThread;
     303begin
     304  MT := GetCurrentMicroThread;
     305  if Assigned(MT) then MT.WaitForEvent(Self, Duration);
     306end;
     307
     308constructor TMicroThreadEvent.Create;
     309begin
     310  FMicroThreads := TObjectList.Create;
     311  FMicroThreads.OwnsObjects := False;
     312  FMicroThreadsLock := TCriticalSection.Create;
     313end;
     314
     315destructor TMicroThreadEvent.Destroy;
     316begin
     317  FMicroThreadsLock.Free;
     318  FMicroThreads.Free;
     319  inherited Destroy;
    220320end;
    221321
     
    390490end;
    391491
    392 { TMicroThreadMethod }
    393 
    394 procedure TMicroThreadMethod.Execute;
     492{ TMicroThreadSimple }
     493
     494procedure TMicroThreadSimple.Execute;
    395495begin
    396496  inherited Execute;
     
    433533  if GetMicroThreadId <> -1 then
    434534  while not FFinished do begin
    435     Sleep(1);
    436   end;
    437 end;
    438 
    439 procedure TMicroThread.Sleep(Duration: TDateTime);
     535    MTSleep(1);
     536  end;
     537end;
     538
     539procedure TMicroThread.MTSleep(Duration: TDateTime);
    440540begin
    441541  FWakeUpTime := NowPrecise + Duration;
     
    444544end;
    445545
    446 function TMicroThread.WaitForSignal(Signal: TEvent): TWaitResult;
    447 begin
     546function TMicroThread.WaitForEvent(Event: TMicroThreadEvent; Duration: TDateTime): TWaitResult;
     547begin
     548  try
     549    Event.FMicroThreadsLock.Acquire;
     550    Event.FMicroThreads.Add(Self);
     551  finally
     552    Event.FMicroThreadsLock.Release;
     553  end;
     554  FBlocked := True;
     555  Yield;
    448556  repeat
    449     Result := Signal.WaitFor(1);
    450     Sleep(1);
     557    if FState = tsBlocked then MTSleep(1);
    451558  until Result <> wrTimeout;
     559  try
     560    Event.FMicroThreadsLock.Acquire;
     561    Event.FMicroThreads.Remove(Self);
     562  finally
     563    Event.FMicroThreadsLock.Release;
     564  end;
    452565end;
    453566
     
    520633end;
    521634
    522 function TMicroThreadScheduler.AddMethod(Method: TMicroThreadEvent): Integer;
    523 var
    524   NewMicroThread: TMicroThreadMethod;
    525 begin
    526   NewMicroThread := TMicroThreadMethod.Create(False);
     635function TMicroThreadScheduler.AddMethod(Method: TMicroThreadMethod): Integer;
     636var
     637  NewMicroThread: TMicroThreadSimple;
     638begin
     639  NewMicroThread := TMicroThreadSimple.Create(False);
    527640  NewMicroThread.Method := Method;
    528641  NewMicroThread.FScheduler := Self;
    529642  Result := Add(NewMicroThread);
     643end;
     644
     645procedure TMicroThreadScheduler.Remove(MicroThread: TMicroThread);
     646begin
     647  try
     648    FMicroThreadsLock.Acquire;
     649    FMicroThreads.Remove(MicroThread);
     650  finally
     651    FMicroThreadsLock.Release;
     652  end;
    530653end;
    531654
     
    664787      if (TMicroThread(FMicroThreads[FRoundRobinIndex]).FState = tsSleeping) and
    665788        (TMicroThread(FMicroThreads[FRoundRobinIndex]).FWakeupTime < CurrentTime) then
    666           TMicroThread(FMicroThreads[FRoundRobinIndex]).FState := tsWaiting else
    667       begin
     789          TMicroThread(FMicroThreads[FRoundRobinIndex]).FState := tsWaiting
     790      else
     791      if (TMicroThread(FMicroThreads[FRoundRobinIndex]).FState = tsBlocked) and
     792        (TMicroThread(FMicroThreads[FRoundRobinIndex]).FBlockCondition) then
     793          TMicroThread(FMicroThreads[FRoundRobinIndex]).FState := tsWaiting
     794      else begin
    668795        // Go to next thread
    669796        Inc(I);
     
    748875initialization
    749876
    750 //StaticManagers := TObjectList.Create;
    751 //MainScheduler := TMicroThreadScheduler.Create;
     877MainScheduler := TMicroThreadScheduler.Create;
    752878
    753879finalization
    754880
    755 //MainScheduler.Free;
    756 //StaticManagers.Free;
     881MainScheduler.Free;
    757882
    758883end.
Note: See TracChangeset for help on using the changeset viewer.