Changeset 154 for MicroThreading


Ignore:
Timestamp:
Jan 27, 2011, 2:15:57 PM (14 years ago)
Author:
george
Message:
  • Add: Not completed event signaling support.
Location:
MicroThreading
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • MicroThreading/Demo/Demo.lpi

    r153 r154  
    3939      </Item2>
    4040    </RequiredPackages>
    41     <Units Count="62">
     41    <Units Count="63">
    4242      <Unit0>
    4343        <Filename Value="Demo.lpr"/>
    4444        <IsPartOfProject Value="True"/>
    4545        <UnitName Value="Demo"/>
     46        <EditorIndex Value="4"/>
    4647        <WindowIndex Value="0"/>
    4748        <TopLine Value="1"/>
    48         <CursorPos X="5" Y="9"/>
    49         <UsageCount Value="68"/>
     49        <CursorPos X="21" Y="18"/>
     50        <UsageCount Value="69"/>
     51        <Loaded Value="True"/>
    5052      </Unit0>
    5153      <Unit1>
    … …  
    5759        <EditorIndex Value="0"/>
    5860        <WindowIndex Value="0"/>
    59         <TopLine Value="1"/>
    60         <CursorPos X="15" Y="67"/>
    61         <UsageCount Value="68"/>
     61        <TopLine Value="263"/>
     62        <CursorPos X="8" Y="276"/>
     63        <UsageCount Value="69"/>
    6264        <Loaded Value="True"/>
    6365        <LoadedDesigner Value="True"/>
    … …  
    6769        <UnitName Value="UMicroThreading"/>
    6870        <IsVisibleTab Value="True"/>
    69         <EditorIndex Value="1"/>
    70         <WindowIndex Value="0"/>
    71         <TopLine Value="446"/>
    72         <CursorPos X="6" Y="450"/>
     71        <EditorIndex Value="2"/>
     72        <WindowIndex Value="0"/>
     73        <TopLine Value="51"/>
     74        <CursorPos X="22" Y="54"/>
    7375        <UsageCount Value="37"/>
    7476        <Loaded Value="True"/>
    … …  
    293295      <Unit32>
    294296        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/classesh.inc"/>
    295         <EditorIndex Value="5"/>
     297        <EditorIndex Value="8"/>
    296298        <WindowIndex Value="0"/>
    297299        <TopLine Value="1467"/>
    … …  
    302304      <Unit33>
    303305        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/tthread.inc"/>
    304         <EditorIndex Value="6"/>
     306        <EditorIndex Value="9"/>
    305307        <WindowIndex Value="0"/>
    306308        <TopLine Value="52"/>
    … …  
    325327      <Unit36>
    326328        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/classes.inc"/>
    327         <EditorIndex Value="7"/>
     329        <EditorIndex Value="10"/>
    328330        <WindowIndex Value="0"/>
    329331        <TopLine Value="124"/>
    … …  
    341343      <Unit38>
    342344        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/sysutils/osutilsh.inc"/>
    343         <EditorIndex Value="2"/>
     345        <EditorIndex Value="5"/>
    344346        <WindowIndex Value="0"/>
    345347        <TopLine Value="14"/>
    346         <CursorPos X="11" Y="27"/>
     348        <CursorPos X="17" Y="27"/>
    347349        <UsageCount Value="13"/>
    348350        <Loaded Value="True"/>
    … …  
    357359      <Unit40>
    358360        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/inc/systemh.inc"/>
    359         <WindowIndex Value="0"/>
    360         <TopLine Value="492"/>
    361         <CursorPos X="3" Y="504"/>
    362         <UsageCount Value="9"/>
     361        <EditorIndex Value="3"/>
     362        <WindowIndex Value="0"/>
     363        <TopLine Value="480"/>
     364        <CursorPos X="3" Y="493"/>
     365        <UsageCount Value="10"/>
     366        <Loaded Value="True"/>
    363367      </Unit40>
    364368      <Unit41>
    … …  
    414418        <Filename Value="../UPlatform.pas"/>
    415419        <UnitName Value="UPlatform"/>
    416         <EditorIndex Value="9"/>
    417         <WindowIndex Value="0"/>
    418         <TopLine Value="1"/>
    419         <CursorPos X="14" Y="1"/>
     420        <EditorIndex Value="12"/>
     421        <WindowIndex Value="0"/>
     422        <TopLine Value="19"/>
     423        <CursorPos X="1" Y="41"/>
    420424        <UsageCount Value="17"/>
    421425        <Loaded Value="True"/>
    … …  
    481485      <Unit57>
    482486        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/lists.inc"/>
    483         <EditorIndex Value="8"/>
     487        <EditorIndex Value="11"/>
    484488        <WindowIndex Value="0"/>
    485489        <TopLine Value="590"/>
    … …  
    490494      <Unit58>
    491495        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/lcl/interfaces/win32/win32callback.inc"/>
    492         <EditorIndex Value="4"/>
     496        <EditorIndex Value="7"/>
    493497        <WindowIndex Value="0"/>
    494498        <TopLine Value="1086"/>
    … …  
    508512        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/lcl/customtimer.pas"/>
    509513        <UnitName Value="CustomTimer"/>
    510         <EditorIndex Value="3"/>
     514        <EditorIndex Value="6"/>
    511515        <WindowIndex Value="0"/>
    512516        <TopLine Value="40"/>
    … …  
    517521      <Unit61>
    518522        <Filename Value="../ReadMe.txt"/>
    519         <EditorIndex Value="10"/>
     523        <EditorIndex Value="13"/>
    520524        <WindowIndex Value="0"/>
    521525        <TopLine Value="1"/>
    … …  
    525529        <DefaultSyntaxHighlighter Value="None"/>
    526530      </Unit61>
     531      <Unit62>
     532        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/lcl/forms.pp"/>
     533        <UnitName Value="Forms"/>
     534        <EditorIndex Value="1"/>
     535        <WindowIndex Value="0"/>
     536        <TopLine Value="57"/>
     537        <CursorPos X="3" Y="70"/>
     538        <UsageCount Value="10"/>
     539        <Loaded Value="True"/>
     540      </Unit62>
    527541    </Units>
    528542    <JumpHistory Count="30" HistoryIndex="29">
    529543      <Position1>
    530544        <Filename Value="../UMicroThreading.pas"/>
    531         <Caret Line="279" Column="19" TopLine="267"/>
     545        <Caret Line="250" Column="1" TopLine="228"/>
    532546      </Position1>
    533547      <Position2>
    534548        <Filename Value="../UMicroThreading.pas"/>
    535         <Caret Line="295" Column="1" TopLine="270"/>
     549        <Caret Line="472" Column="1" TopLine="459"/>
    536550      </Position2>
    537551      <Position3>
    538552        <Filename Value="../UMicroThreading.pas"/>
    539         <Caret Line="289" Column="1" TopLine="270"/>
     553        <Caret Line="473" Column="1" TopLine="459"/>
    540554      </Position3>
    541555      <Position4>
    542556        <Filename Value="../UMicroThreading.pas"/>
    543         <Caret Line="290" Column="1" TopLine="270"/>
     557        <Caret Line="474" Column="1" TopLine="459"/>
    544558      </Position4>
    545559      <Position5>
    546560        <Filename Value="../UMicroThreading.pas"/>
    547         <Caret Line="291" Column="1" TopLine="270"/>
     561        <Caret Line="459" Column="1" TopLine="446"/>
    548562      </Position5>
    549563      <Position6>
    550564        <Filename Value="../UMicroThreading.pas"/>
    551         <Caret Line="292" Column="1" TopLine="270"/>
     565        <Caret Line="267" Column="1" TopLine="254"/>
    552566      </Position6>
    553567      <Position7>
    554568        <Filename Value="../UMicroThreading.pas"/>
    555         <Caret Line="598" Column="50" TopLine="587"/>
     569        <Caret Line="268" Column="1" TopLine="254"/>
    556570      </Position7>
    557571      <Position8>
    558         <Filename Value="../UMicroThreading.pas"/>
    559         <Caret Line="291" Column="40" TopLine="278"/>
     572        <Filename Value="../UPlatform.pas"/>
     573        <Caret Line="29" Column="1" TopLine="16"/>
    560574      </Position8>
    561575      <Position9>
    562         <Filename Value="../UMicroThreading.pas"/>
    563         <Caret Line="280" Column="1" TopLine="272"/>
     576        <Filename Value="../UPlatform.pas"/>
     577        <Caret Line="31" Column="1" TopLine="16"/>
    564578      </Position9>
    565579      <Position10>
    566         <Filename Value="../UMicroThreading.pas"/>
    567         <Caret Line="288" Column="26" TopLine="272"/>
     580        <Filename Value="../UPlatform.pas"/>
     581        <Caret Line="40" Column="1" TopLine="18"/>
    568582      </Position10>
    569583      <Position11>
    570         <Filename Value="../UMicroThreading.pas"/>
    571         <Caret Line="285" Column="35" TopLine="272"/>
     584        <Filename Value="../UPlatform.pas"/>
     585        <Caret Line="41" Column="1" TopLine="19"/>
    572586      </Position11>
    573587      <Position12>
    574588        <Filename Value="../UMicroThreading.pas"/>
    575         <Caret Line="288" Column="1" TopLine="272"/>
     589        <Caret Line="269" Column="1" TopLine="254"/>
    576590      </Position12>
    577591      <Position13>
    578592        <Filename Value="../UMicroThreading.pas"/>
    579         <Caret Line="289" Column="1" TopLine="272"/>
     593        <Caret Line="270" Column="1" TopLine="260"/>
    580594      </Position13>
    581595      <Position14>
    582596        <Filename Value="../UMicroThreading.pas"/>
    583         <Caret Line="290" Column="1" TopLine="272"/>
     597        <Caret Line="273" Column="1" TopLine="260"/>
    584598      </Position14>
    585599      <Position15>
    586600        <Filename Value="../UMicroThreading.pas"/>
    587         <Caret Line="291" Column="1" TopLine="272"/>
     601        <Caret Line="274" Column="1" TopLine="260"/>
    588602      </Position15>
    589603      <Position16>
    590604        <Filename Value="../UMicroThreading.pas"/>
    591         <Caret Line="292" Column="1" TopLine="272"/>
     605        <Caret Line="275" Column="1" TopLine="260"/>
    592606      </Position16>
    593607      <Position17>
    594608        <Filename Value="../UMicroThreading.pas"/>
    595         <Caret Line="293" Column="1" TopLine="272"/>
     609        <Caret Line="276" Column="1" TopLine="260"/>
    596610      </Position17>
    597611      <Position18>
    598612        <Filename Value="../UMicroThreading.pas"/>
    599         <Caret Line="296" Column="1" TopLine="274"/>
     613        <Caret Line="277" Column="1" TopLine="260"/>
    600614      </Position18>
    601615      <Position19>
    602616        <Filename Value="../UMicroThreading.pas"/>
    603         <Caret Line="297" Column="1" TopLine="275"/>
     617        <Caret Line="278" Column="1" TopLine="260"/>
    604618      </Position19>
    605619      <Position20>
    606620        <Filename Value="../UMicroThreading.pas"/>
    607         <Caret Line="298" Column="1" TopLine="276"/>
     621        <Caret Line="281" Column="1" TopLine="260"/>
    608622      </Position20>
    609623      <Position21>
    610624        <Filename Value="../UMicroThreading.pas"/>
    611         <Caret Line="299" Column="1" TopLine="277"/>
     625        <Caret Line="282" Column="1" TopLine="260"/>
    612626      </Position21>
    613627      <Position22>
    614628        <Filename Value="../UMicroThreading.pas"/>
    615         <Caret Line="471" Column="1" TopLine="458"/>
     629        <Caret Line="283" Column="1" TopLine="261"/>
    616630      </Position22>
    617631      <Position23>
    618632        <Filename Value="../UMicroThreading.pas"/>
    619         <Caret Line="285" Column="32" TopLine="275"/>
     633        <Caret Line="284" Column="1" TopLine="262"/>
    620634      </Position23>
    621635      <Position24>
    622         <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/classesh.inc"/>
    623         <Caret Line="1488" Column="37" TopLine="1467"/>
     636        <Filename Value="../UMicroThreading.pas"/>
     637        <Caret Line="286" Column="1" TopLine="264"/>
    624638      </Position24>
    625639      <Position25>
    626         <Filename Value="../UMicroThreading.pas"/>
    627         <Caret Line="71" Column="5" TopLine="55"/>
     640        <Filename Value="UMainForm.pas"/>
     641        <Caret Line="276" Column="1" TopLine="263"/>
    628642      </Position25>
    629643      <Position26>
    630644        <Filename Value="../UMicroThreading.pas"/>
    631         <Caret Line="125" Column="1" TopLine="110"/>
     645        <Caret Line="249" Column="1" TopLine="236"/>
    632646      </Position26>
    633647      <Position27>
    634         <Filename Value="UMainForm.pas"/>
    635         <Caret Line="68" Column="29" TopLine="54"/>
     648        <Filename Value="../UMicroThreading.pas"/>
     649        <Caret Line="250" Column="1" TopLine="236"/>
    636650      </Position27>
    637651      <Position28>
    638         <Filename Value="../UMicroThreading.pas"/>
    639         <Caret Line="566" Column="20" TopLine="561"/>
     652        <Filename Value="UMainForm.pas"/>
     653        <Caret Line="276" Column="8" TopLine="263"/>
    640654      </Position28>
    641655      <Position29>
    642656        <Filename Value="../UMicroThreading.pas"/>
    643         <Caret Line="567" Column="23" TopLine="554"/>
     657        <Caret Line="250" Column="29" TopLine="245"/>
    644658      </Position29>
    645659      <Position30>
    646660        <Filename Value="../UMicroThreading.pas"/>
    647         <Caret Line="579" Column="51" TopLine="560"/>
     661        <Caret Line="64" Column="17" TopLine="51"/>
    648662      </Position30>
    649663    </JumpHistory>

  • MicroThreading/Demo/UMainForm.pas

    r153 r154  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ComCtrls, ExtCtrls, Spin, UMicroThreading, Coroutine, DateUtils, UPlatform;
     9  ComCtrls, ExtCtrls, Spin, UMicroThreading, DateUtils, UPlatform;
    1010
    1111type
    … …  
    6767    procedure Worker(MicroThread: TMicroThread);
    6868    procedure WorkerDoWrite;
     69    procedure WorkerSubRoutine;
    6970  public
    7071    Iterations: Integer;
    71     Scheduler: TMicroThreadScheduler;
    7272  end;
    7373
    … …  
    8585procedure TMainForm.FormCreate(Sender: TObject);
    8686begin
    87   Scheduler := TMicroThreadScheduler.Create;
    8887  DoubleBuffered := True;
    8988  ListView1.DoubleBuffered := True;
    … …  
    9796  if ButtonSchedulerStartStop.Caption = 'Start scheduler' then begin
    9897    ButtonSchedulerStartStop.Caption := 'Stop scheduler';
    99     Scheduler.ThreadPoolSize := SpinEdit2.Value;
    100     Scheduler.Active := True;
     98    MainScheduler.ThreadPoolSize := SpinEdit2.Value;
     99    MainScheduler.Active := True;
    101100  end else begin
    102101    ButtonSchedulerStartStop.Caption := 'Start scheduler';
    103     Scheduler.Active := False;
     102    MainScheduler.Active := False;
    104103  end;
    105104end;
    … …  
    169168  //Scheduler.FMicroThreads.Clear;
    170169  for I := 0 to SpinEdit1.Value - 1 do
    171     Scheduler.AddMethod(Worker);
     170    MainScheduler.AddMethod(Worker);
    172171end;
    173172
    … …  
    197196begin
    198197  try
    199     Scheduler.MicroThreadsLock.Acquire;
    200     Scheduler.MicroThreads.Clear;
     198    MainScheduler.MicroThreadsLock.Acquire;
     199    MainScheduler.MicroThreads.Clear;
    201200  finally
    202     Scheduler.MicroThreadsLock.Release;
     201    MainScheduler.MicroThreadsLock.Release;
    203202  end;
    204203end;
    … …  
    206205procedure TMainForm.CheckBoxUseMainThreadChange(Sender: TObject);
    207206begin
    208   Scheduler.UseMainThread := CheckBoxUseMainThread.Checked;
     207  MainScheduler.UseMainThread := CheckBoxUseMainThread.Checked;
    209208end;
    210209
    211210procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
    212211begin
    213   Scheduler.Active := False;
     212  MainScheduler.Active := False;
    214213end;
    215214
    216215procedure TMainForm.FormDestroy(Sender: TObject);
    217216begin
    218   Scheduler.Free;
     217  MainScheduler.Free;
    219218end;
    220219
    … …  
    227226begin
    228227  try
    229     Scheduler.MicroThreadsLock.Acquire;
    230     if Item.Index < Scheduler.MicroThreads.Count then
    231     with TMicroThread(Scheduler.MicroThreads[Item.Index]) do begin
     228    MainScheduler.MicroThreadsLock.Acquire;
     229    if Item.Index < MainScheduler.MicroThreads.Count then
     230    with TMicroThread(MainScheduler.MicroThreads[Item.Index]) do begin
    232231      Item.Caption := IntToStr(Id);
    233232      Item.SubItems.Add(Name);
    … …  
    240239    end;
    241240  finally
    242     Scheduler.MicroThreadsLock.Release;
     241    MainScheduler.MicroThreadsLock.Release;
    243242  end;
    244243end;
    … …  
    246245procedure TMainForm.SpinEdit2Change(Sender: TObject);
    247246begin
    248   Scheduler.ThreadPoolSize := SpinEdit2.Value;
     247  MainScheduler.ThreadPoolSize := SpinEdit2.Value;
    249248end;
    250249
    … …  
    256255procedure TMainForm.TimerRedrawTimer(Sender: TObject);
    257256begin
    258   if ListView1.Items.Count <> Scheduler.MicroThreadCount then
    259     ListView1.Items.Count := Scheduler.MicroThreadCount;
     257  if ListView1.Items.Count <> MainScheduler.MicroThreadCount then
     258    ListView1.Items.Count := MainScheduler.MicroThreadCount;
    260259  ListView1.Items[-1];
    261260  ListView1.Refresh;
    262261  Label2.Caption := DateTimeToStr(NowPrecise) + ' ' +
    263262    FloatToStr(Frac(NowPrecise / OneSecond));
    264   Label9.Caption := IntToStr(Scheduler.ThreadPoolCount);
    265   Label10.Caption := IntToStr(Scheduler.MicroThreadCount);
     263  Label9.Caption := IntToStr(MainScheduler.ThreadPoolCount);
     264  Label10.Caption := IntToStr(MainScheduler.MicroThreadCount);
    266265end;
    267266
    … …  
    271270  ButtonAddWorkers.Click;
    272271  ButtonSchedulerStartStop.Click;
     272end;
     273
     274procedure TMainForm.WorkerSubRoutine;
     275begin
     276  MTSleep(1 * OneMillisecond);
    273277end;
    274278
    … …  
    287291      //  FloatToStr(ExecutionTime));
    288292      Completion := I / Iterations;
    289       //Sleep(1 * Id * OneMillisecond);
     293      //MTSleep(1 * Id * OneMillisecond);
    290294      Yield;
     295      WorkerSubRoutine;
    291296    end;
    292297  end;

  • 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.