Changeset 142


Ignore:
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.
Location:
MicroThreading
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • MicroThreading/Demo/Demo.lpi

    r141 r142  
    4242      </Item3>
    4343    </RequiredPackages>
    44     <Units Count="28">
     44    <Units Count="38">
    4545      <Unit0>
    4646        <Filename Value="Demo.lpr"/>
    … …  
    5050        <TopLine Value="1"/>
    5151        <CursorPos X="1" Y="15"/>
    52         <UsageCount Value="39"/>
     52        <UsageCount Value="40"/>
    5353      </Unit0>
    5454      <Unit1>
    … …  
    5858        <ResourceBaseClass Value="Form"/>
    5959        <UnitName Value="UMainForm"/>
    60         <IsVisibleTab Value="True"/>
    6160        <EditorIndex Value="0"/>
    6261        <WindowIndex Value="0"/>
    63         <TopLine Value="176"/>
    64         <CursorPos X="42" Y="177"/>
    65         <UsageCount Value="39"/>
     62        <TopLine Value="147"/>
     63        <CursorPos X="29" Y="148"/>
     64        <UsageCount Value="40"/>
    6665        <Loaded Value="True"/>
    6766        <LoadedDesigner Value="True"/>
    … …  
    7069        <Filename Value="../UMicroThreading.pas"/>
    7170        <UnitName Value="UMicroThreading"/>
    72         <EditorIndex Value="10"/>
    73         <WindowIndex Value="0"/>
    74         <TopLine Value="183"/>
    75         <CursorPos X="20" Y="194"/>
    76         <UsageCount Value="20"/>
     71        <IsVisibleTab Value="True"/>
     72        <EditorIndex Value="3"/>
     73        <WindowIndex Value="0"/>
     74        <TopLine Value="152"/>
     75        <CursorPos X="32" Y="165"/>
     76        <UsageCount Value="21"/>
    7777        <Loaded Value="True"/>
    7878      </Unit2>
    … …  
    120120        <Filename Value="../../ExceptionLogger/UStackTrace.pas"/>
    121121        <UnitName Value="UStackTrace"/>
    122         <EditorIndex Value="8"/>
    123122        <WindowIndex Value="0"/>
    124123        <TopLine Value="56"/>
    125124        <CursorPos X="24" Y="77"/>
    126125        <UsageCount Value="20"/>
    127         <Loaded Value="True"/>
    128126        <DefaultSyntaxHighlighter Value="Delphi"/>
    129127      </Unit8>
    … …  
    131129        <Filename Value="../../ExceptionLogger/CustomLineInfo.pas"/>
    132130        <UnitName Value="CustomLineInfo"/>
    133         <EditorIndex Value="9"/>
    134131        <WindowIndex Value="0"/>
    135132        <TopLine Value="264"/>
    136133        <CursorPos X="37" Y="141"/>
    137134        <UsageCount Value="20"/>
    138         <Loaded Value="True"/>
    139135        <DefaultSyntaxHighlighter Value="Delphi"/>
    140136      </Unit9>
    … …  
    185181        <Filename Value="../Other/Coroutine.pas"/>
    186182        <UnitName Value="Coroutine"/>
    187         <EditorIndex Value="6"/>
    188183        <WindowIndex Value="0"/>
    189184        <TopLine Value="290"/>
    190185        <CursorPos X="36" Y="306"/>
    191         <UsageCount Value="20"/>
    192         <Loaded Value="True"/>
     186        <UsageCount Value="21"/>
    193187      </Unit16>
    194188      <Unit17>
    … …  
    230224        <Filename Value="../MicroThreading.pas"/>
    231225        <UnitName Value="MicroThreading"/>
    232         <EditorIndex Value="7"/>
    233226        <WindowIndex Value="0"/>
    234227        <TopLine Value="1"/>
    235228        <CursorPos X="25" Y="9"/>
    236         <UsageCount Value="12"/>
    237         <Loaded Value="True"/>
     229        <UsageCount Value="13"/>
    238230      </Unit22>
    239231      <Unit23>
    … …  
    243235        <TopLine Value="38"/>
    244236        <CursorPos X="29" Y="50"/>
    245         <UsageCount Value="12"/>
     237        <UsageCount Value="13"/>
    246238        <Loaded Value="True"/>
    247239      </Unit23>
    … …  
    252244        <TopLine Value="161"/>
    253245        <CursorPos X="11" Y="184"/>
    254         <UsageCount Value="12"/>
     246        <UsageCount Value="13"/>
    255247        <Loaded Value="True"/>
    256248      </Unit24>
    257249      <Unit25>
    258250        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/sysutils/dati.inc"/>
    259         <EditorIndex Value="5"/>
    260251        <WindowIndex Value="0"/>
    261252        <TopLine Value="254"/>
    262253        <CursorPos X="12" Y="258"/>
    263         <UsageCount Value="12"/>
    264         <Loaded Value="True"/>
     254        <UsageCount Value="13"/>
    265255      </Unit25>
    266256      <Unit26>
    267257        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/sysutils.pp"/>
    268258        <UnitName Value="sysutils"/>
    269         <EditorIndex Value="3"/>
    270259        <WindowIndex Value="0"/>
    271260        <TopLine Value="581"/>
    272261        <CursorPos X="11" Y="585"/>
    273         <UsageCount Value="12"/>
    274         <Loaded Value="True"/>
     262        <UsageCount Value="13"/>
    275263      </Unit26>
    276264      <Unit27>
    277265        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/wininc/redef.inc"/>
    278         <EditorIndex Value="4"/>
    279266        <WindowIndex Value="0"/>
    280267        <TopLine Value="525"/>
    281268        <CursorPos X="11" Y="538"/>
    282         <UsageCount Value="12"/>
    283         <Loaded Value="True"/>
     269        <UsageCount Value="13"/>
    284270      </Unit27>
     271      <Unit28>
     272        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/packages/fcl-base/src/syncobjs.pp"/>
     273        <UnitName Value="syncobjs"/>
     274        <EditorIndex Value="10"/>
     275        <WindowIndex Value="0"/>
     276        <TopLine Value="57"/>
     277        <CursorPos X="16" Y="70"/>
     278        <UsageCount Value="10"/>
     279        <Loaded Value="True"/>
     280      </Unit28>
     281      <Unit29>
     282        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/inc/threadh.inc"/>
     283        <EditorIndex Value="11"/>
     284        <WindowIndex Value="0"/>
     285        <TopLine Value="18"/>
     286        <CursorPos X="50" Y="31"/>
     287        <UsageCount Value="10"/>
     288        <Loaded Value="True"/>
     289      </Unit29>
     290      <Unit30>
     291        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/inc/thread.inc"/>
     292        <EditorIndex Value="13"/>
     293        <WindowIndex Value="0"/>
     294        <TopLine Value="109"/>
     295        <CursorPos X="3" Y="112"/>
     296        <UsageCount Value="10"/>
     297        <Loaded Value="True"/>
     298      </Unit30>
     299      <Unit31>
     300        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/sysosh.inc"/>
     301        <EditorIndex Value="12"/>
     302        <WindowIndex Value="0"/>
     303        <TopLine Value="12"/>
     304        <CursorPos X="3" Y="25"/>
     305        <UsageCount Value="10"/>
     306        <Loaded Value="True"/>
     307      </Unit31>
     308      <Unit32>
     309        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/classesh.inc"/>
     310        <EditorIndex Value="5"/>
     311        <WindowIndex Value="0"/>
     312        <TopLine Value="1507"/>
     313        <CursorPos X="3" Y="1469"/>
     314        <UsageCount Value="10"/>
     315        <Loaded Value="True"/>
     316      </Unit32>
     317      <Unit33>
     318        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/tthread.inc"/>
     319        <EditorIndex Value="7"/>
     320        <WindowIndex Value="0"/>
     321        <TopLine Value="96"/>
     322        <CursorPos X="15" Y="98"/>
     323        <UsageCount Value="10"/>
     324        <Loaded Value="True"/>
     325      </Unit33>
     326      <Unit34>
     327        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/wininc/func.inc"/>
     328        <EditorIndex Value="9"/>
     329        <WindowIndex Value="0"/>
     330        <TopLine Value="130"/>
     331        <CursorPos X="10" Y="143"/>
     332        <UsageCount Value="10"/>
     333        <Loaded Value="True"/>
     334      </Unit34>
     335      <Unit35>
     336        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/wininc/defines.inc"/>
     337        <EditorIndex Value="8"/>
     338        <WindowIndex Value="0"/>
     339        <TopLine Value="1923"/>
     340        <CursorPos X="6" Y="1936"/>
     341        <UsageCount Value="10"/>
     342        <Loaded Value="True"/>
     343      </Unit35>
     344      <Unit36>
     345        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/classes.inc"/>
     346        <EditorIndex Value="6"/>
     347        <WindowIndex Value="0"/>
     348        <TopLine Value="109"/>
     349        <CursorPos X="6" Y="115"/>
     350        <UsageCount Value="10"/>
     351        <Loaded Value="True"/>
     352      </Unit36>
     353      <Unit37>
     354        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/inc/objpash.inc"/>
     355        <EditorIndex Value="4"/>
     356        <WindowIndex Value="0"/>
     357        <TopLine Value="181"/>
     358        <CursorPos X="21" Y="194"/>
     359        <UsageCount Value="10"/>
     360        <Loaded Value="True"/>
     361      </Unit37>
    285362    </Units>
    286363    <JumpHistory Count="30" HistoryIndex="29">
    287364      <Position1>
    288         <Filename Value="UMainForm.pas"/>
    289         <Caret Line="41" Column="24" TopLine="28"/>
     365        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/inc/threadh.inc"/>
     366        <Caret Line="63" Column="35" TopLine="49"/>
    290367      </Position1>
    291368      <Position2>
    292         <Filename Value="UMainForm.pas"/>
    293         <Caret Line="182" Column="45" TopLine="169"/>
     369        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/inc/threadh.inc"/>
     370        <Caret Line="31" Column="50" TopLine="18"/>
    294371      </Position2>
    295372      <Position3>
    296373        <Filename Value="../UMicroThreading.pas"/>
    297         <Caret Line="8" Column="57" TopLine="1"/>
     374        <Caret Line="24" Column="7" TopLine="23"/>
    298375      </Position3>
    299376      <Position4>
    300377        <Filename Value="../UMicroThreading.pas"/>
    301         <Caret Line="71" Column="20" TopLine="49"/>
     378        <Caret Line="152" Column="4" TopLine="180"/>
    302379      </Position4>
    303380      <Position5>
    304381        <Filename Value="../UMicroThreading.pas"/>
    305         <Caret Line="97" Column="24" TopLine="75"/>
     382        <Caret Line="189" Column="1" TopLine="180"/>
    306383      </Position5>
    307384      <Position6>
    308385        <Filename Value="../UMicroThreading.pas"/>
    309         <Caret Line="119" Column="38" TopLine="97"/>
     386        <Caret Line="190" Column="1" TopLine="180"/>
    310387      </Position6>
    311388      <Position7>
    312389        <Filename Value="../UMicroThreading.pas"/>
    313         <Caret Line="126" Column="61" TopLine="104"/>
     390        <Caret Line="185" Column="1" TopLine="180"/>
    314391      </Position7>
    315392      <Position8>
    316393        <Filename Value="../UMicroThreading.pas"/>
    317         <Caret Line="182" Column="34" TopLine="147"/>
     394        <Caret Line="186" Column="1" TopLine="180"/>
    318395      </Position8>
    319396      <Position9>
    320397        <Filename Value="../UMicroThreading.pas"/>
    321         <Caret Line="277" Column="45" TopLine="258"/>
     398        <Caret Line="191" Column="1" TopLine="180"/>
    322399      </Position9>
    323400      <Position10>
    324401        <Filename Value="../UMicroThreading.pas"/>
    325         <Caret Line="136" Column="14" TopLine="120"/>
     402        <Caret Line="149" Column="1" TopLine="136"/>
    326403      </Position10>
    327404      <Position11>
    328         <Filename Value="UMainForm.pas"/>
    329         <Caret Line="191" Column="91" TopLine="173"/>
     405        <Filename Value="../UMicroThreading.pas"/>
     406        <Caret Line="189" Column="1" TopLine="176"/>
    330407      </Position11>
    331408      <Position12>
    332         <Filename Value="UMainForm.pas"/>
    333         <Caret Line="179" Column="40" TopLine="165"/>
     409        <Filename Value="../UMicroThreading.pas"/>
     410        <Caret Line="190" Column="1" TopLine="176"/>
    334411      </Position12>
    335412      <Position13>
    336413        <Filename Value="../UMicroThreading.pas"/>
    337         <Caret Line="193" Column="1" TopLine="181"/>
     414        <Caret Line="185" Column="1" TopLine="176"/>
    338415      </Position13>
    339416      <Position14>
    340417        <Filename Value="../UMicroThreading.pas"/>
    341         <Caret Line="11" Column="56" TopLine="1"/>
     418        <Caret Line="186" Column="1" TopLine="176"/>
    342419      </Position14>
    343420      <Position15>
    344421        <Filename Value="../UMicroThreading.pas"/>
    345         <Caret Line="15" Column="33" TopLine="1"/>
     422        <Caret Line="191" Column="1" TopLine="176"/>
    346423      </Position15>
    347424      <Position16>
    348         <Filename Value="UMainForm.pas"/>
    349         <Caret Line="202" Column="91" TopLine="183"/>
     425        <Filename Value="../UMicroThreading.pas"/>
     426        <Caret Line="149" Column="1" TopLine="136"/>
    350427      </Position16>
    351428      <Position17>
    352429        <Filename Value="../UMicroThreading.pas"/>
    353         <Caret Line="42" Column="22" TopLine="22"/>
     430        <Caret Line="156" Column="1" TopLine="136"/>
    354431      </Position17>
    355432      <Position18>
    356433        <Filename Value="../UMicroThreading.pas"/>
    357         <Caret Line="92" Column="1" TopLine="92"/>
     434        <Caret Line="157" Column="1" TopLine="136"/>
    358435      </Position18>
    359436      <Position19>
    360         <Filename Value="UMainForm.pas"/>
    361         <Caret Line="89" Column="19" TopLine="72"/>
     437        <Filename Value="../UMicroThreading.pas"/>
     438        <Caret Line="158" Column="1" TopLine="136"/>
    362439      </Position19>
    363440      <Position20>
    364441        <Filename Value="../UMicroThreading.pas"/>
    365         <Caret Line="75" Column="22" TopLine="62"/>
     442        <Caret Line="189" Column="1" TopLine="176"/>
    366443      </Position20>
    367444      <Position21>
    368         <Filename Value="UMainForm.pas"/>
    369         <Caret Line="89" Column="22" TopLine="76"/>
     445        <Filename Value="../UMicroThreading.pas"/>
     446        <Caret Line="190" Column="1" TopLine="176"/>
    370447      </Position21>
    371448      <Position22>
    372449        <Filename Value="../UMicroThreading.pas"/>
    373         <Caret Line="175" Column="9" TopLine="175"/>
     450        <Caret Line="409" Column="21" TopLine="387"/>
    374451      </Position22>
    375452      <Position23>
    376453        <Filename Value="../UMicroThreading.pas"/>
    377         <Caret Line="79" Column="20" TopLine="64"/>
     454        <Caret Line="206" Column="18" TopLine="201"/>
    378455      </Position23>
    379456      <Position24>
    380457        <Filename Value="../UMicroThreading.pas"/>
    381         <Caret Line="172" Column="23" TopLine="170"/>
     458        <Caret Line="21" Column="15" TopLine="7"/>
    382459      </Position24>
    383460      <Position25>
    384461        <Filename Value="../UMicroThreading.pas"/>
    385         <Caret Line="349" Column="1" TopLine="1"/>
     462        <Caret Line="123" Column="50" TopLine="110"/>
    386463      </Position25>
    387464      <Position26>
    388465        <Filename Value="../UMicroThreading.pas"/>
    389         <Caret Line="192" Column="17" TopLine="179"/>
     466        <Caret Line="165" Column="29" TopLine="145"/>
    390467      </Position26>
    391468      <Position27>
    392469        <Filename Value="../UMicroThreading.pas"/>
    393         <Caret Line="11" Column="66" TopLine="1"/>
     470        <Caret Line="148" Column="31" TopLine="135"/>
    394471      </Position27>
    395472      <Position28>
    396         <Filename Value="UMainForm.pas"/>
    397         <Caret Line="43" Column="1" TopLine="30"/>
     473        <Filename Value="../UMicroThreading.pas"/>
     474        <Caret Line="165" Column="26" TopLine="152"/>
    398475      </Position28>
    399476      <Position29>
    400         <Filename Value="UMainForm.pas"/>
    401         <Caret Line="83" Column="1" TopLine="70"/>
     477        <Filename Value="../UMicroThreading.pas"/>
     478        <Caret Line="148" Column="31" TopLine="148"/>
    402479      </Position29>
    403480      <Position30>
    404         <Filename Value="UMainForm.pas"/>
    405         <Caret Line="154" Column="16" TopLine="141"/>
     481        <Filename Value="../UMicroThreading.pas"/>
     482        <Caret Line="150" Column="31" TopLine="135"/>
    406483      </Position30>
    407484    </JumpHistory>
    … …  
    439516      <Item3>
    440517        <Source Value="umainform.pas"/>
    441         <Line Value="55"/>
     518        <Line Value="58"/>
    442519      </Item3>
    443520      <Item4>

  • MicroThreading/Demo/UMainForm.lfm

    r140 r142  
    1515    Height = 25
    1616    Top = 13
    17     Width = 119
     17    Width = 103
    1818    Caption = 'Start scheduler'
    1919    OnClick = Button1Click
    … …  
    6464  object Memo1: TMemo
    6565    Left = 10
    66     Height = 419
    67     Top = 88
     66    Height = 379
     67    Top = 128
    6868    Width = 294
    6969    Anchors = [akTop, akLeft, akBottom]
    … …  
    7272  end
    7373  object Button2: TButton
    74     Left = 176
     74    Left = 224
    7575    Height = 25
    76     Top = 13
     76    Top = 96
    7777    Width = 75
    7878    Caption = 'Button2'
    … …  
    8383    Left = 10
    8484    Height = 25
    85     Top = 57
     85    Top = 96
    8686    Width = 75
    8787    Caption = 'Coroutine'
    … …  
    9292    Left = 10
    9393    Height = 14
    94     Top = 40
     94    Top = 80
    9595    Width = 32
    9696    Caption = 'Label2'
    9797    ParentColor = False
     98  end
     99  object Button4: TButton
     100    Left = 136
     101    Height = 25
     102    Top = 12
     103    Width = 75
     104    Caption = 'Start workers'
     105    OnClick = Button4Click
     106    TabOrder = 5
     107  end
     108  object SpinEdit1: TSpinEdit
     109    Left = 217
     110    Height = 21
     111    Top = 13
     112    Width = 82
     113    MaxValue = 100000
     114    MinValue = 1
     115    TabOrder = 6
     116    Value = 20
    98117  end
    99118  object Timer1: TTimer

  • MicroThreading/Demo/UMainForm.pas

    r141 r142  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ComCtrls, ExtCtrls, UMicroThreading, Coroutine, DateUtils;
     9  ComCtrls, ExtCtrls, Spin, UMicroThreading, Coroutine, DateUtils;
    1010
    1111type
    … …  
    2323    Button2: TButton;
    2424    Button3: TButton;
     25    Button4: TButton;
    2526    Label1: TLabel;
    2627    Label2: TLabel;
    2728    ListView1: TListView;
    2829    Memo1: TMemo;
     30    SpinEdit1: TSpinEdit;
    2931    Timer1: TTimer;
    3032    procedure Button1Click(Sender: TObject);
    3133    procedure Button2Click(Sender: TObject);
    3234    procedure Button3Click(Sender: TObject);
     35    procedure Button4Click(Sender: TObject);
    3336    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    3437    procedure FormCreate(Sender: TObject);
    … …  
    7073begin
    7174  Scheduler := TMicroThreadScheduler.Create;
    72   Scheduler.FreeMicroThreadOnFinish := False;
    7375  Test := TTest.Create;
    7476  DoubleBuffered := True;
    … …  
    8486    Scheduler.MicroThreads.Clear;
    8587    Memo1.Clear;
    86     for I := 0 to 20 do
    87       Scheduler.Add('Worker', Worker);
    8888    Scheduler.Start;
    8989  end else begin
    … …  
    149149begin
    150150  Test.Invoke;
     151end;
     152
     153procedure TForm1.Button4Click(Sender: TObject);
     154var
     155  I: Integer;
     156begin
     157  for I := 0 to SpinEdit1.Value do
     158    Scheduler.AddMethod(Worker);
    151159end;
    152160

  • MicroThreading/MicroThreading.lpk

    r140 r142  
    33  <Package Version="3">
    44    <Name Value="MicroThreading"/>
     5    <Author Value="Chronos"/>
    56    <CompilerOptions>
    67      <Version Value="9"/>
    … …  
    1314      </Other>
    1415    </CompilerOptions>
     16    <Description Value="Micro threading subsystem. "/>
     17    <License Value="GNU/GPL"/>
     18    <Version Minor="1"/>
    1519    <Files Count="2">
    1620      <Item1>

  • MicroThreading/UMicroThreading.pas

    r141 r142  
    1111  Classes, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms;
    1212
     13const
     14  DefaultStackSize = $4000;
     15
    1316type
    1417  TMicroThread = class;
    1518  TMicroThreadScheduler = class;
    1619
    17   TStartEvent = procedure(MicroThread: TMicroThread) of object;
    18 
    19   TMicroThreadState = (tsReady, tsRunning, tsWaiting, tsBlocked, tsSuspended,
    20     tsSleeping, tsFinished);
     20  TMicroThreadState = (tsWaiting, tsRunning, tsBlocked, tsSuspended,
     21    tsSleeping);
     22
    2123
    2224  { TMicroThread }
    … …  
    2426  TMicroThread = class
    2527  private
    26     FMethod: TStartEvent;
     28    FFreeOnTerminate: Boolean;
    2729    FStack: Pointer;
    2830    FStackSize: Integer;
    … …  
    3335    FBasePointer: Pointer;
    3436    FWakeupTime: TDateTime;
     37    FTerminated: Boolean;
     38    FExecuted: Boolean; // At first go through Execute method, then switch context
     39    FFinished: Boolean;
    3540  public
    3641    Id: Integer;
    … …  
    3944    State: TMicroThreadState;
    4045    Scheduler: TMicroThreadScheduler;
     46    procedure Execute; virtual;
     47
     48    // Internal execution
    4149    procedure Yield;
    4250    procedure Sleep(Duration: TDateTime);
    43     constructor Create;
     51    function WaitForSignal(Signal: TEvent): TWaitResult;
     52
     53    // External execution
     54    procedure WaitFor;
     55    procedure Terminate;
     56    procedure Start;
     57    procedure Stop;
     58
     59    constructor Create(CreateSuspended: Boolean;
     60      const StackSize: SizeUInt = DefaultStackSize);
    4461    destructor Destroy; override;
    45     property Method: TStartEvent read FMethod write FMethod;
    4662    property ExecutionTime: TDateTime read FExecutionTime;
     63    property FreeOnTerminate: Boolean read FFreeOnTerminate
     64      write FFreeOnTerminate;
     65    property Terminated: Boolean read FTerminated;
     66  end;
     67
     68  TMicroThreadEvent = procedure(MicroThread: TMicroThread) of object;
     69
     70  { TMicroThreadMethod }
     71
     72  TMicroThreadMethod = class(TMicroThread)
     73    Method: TMicroThreadEvent;
     74    procedure Execute; override;
    4775  end;
    4876
    … …  
    5583  TMicroThreadScheduler = class
    5684  private
    57     FFreeMicroThreadOnFinish: Boolean;
    5885    ThreadPool: TThreadPool;
    5986    RoundRobinIndex: Integer;
    … …  
    6794    FExecutedCount: Integer;
    6895    FTerminated: Boolean;
     96    FThreadPoolSize: Integer;
    6997    function GetMicroThreadCount: Integer;
     98    function GetThreadPoolSize: Integer;
     99    procedure SetThreadPoolSize(const AValue: Integer);
    70100    procedure Yield(MicroThread: TMicroThread);
    71101  public
    72102    MicroThreads: TObjectList; // TList<TMicroThread>
    73103    Lock: TCriticalSection;
     104    CurrentMicroThread: TMicroThread;
    74105    function GetNow: TDateTime;
    75     function Add(Name: string; Method: TStartEvent): TMicroThread;
     106    function Add(MicroThread: TMicroThread): Integer;
     107    function AddMethod(Method: TMicroThreadEvent): Integer;
    76108    constructor Create;
    77109    destructor Destroy; override;
    … …  
    80112    procedure Stop;
    81113    property MicroThreadCount: Integer read GetMicroThreadCount;
    82     property FreeMicroThreadOnFinish: Boolean read FFreeMicroThreadOnFinish
    83       write FFreeMicroThreadOnFinish;
    84   end;
     114    property ThreadPoolSize: Integer read GetThreadPoolSize
     115      write SetThreadPoolSize;
     116  end;
     117
     118var
     119  MainScheduler: TMicroThreadScheduler;
    85120
    86121const
    87   MicroThreadStateText: array[TMicroThreadState] of string = ('Ready', 'Running',
    88     'Waiting', 'Blocked', 'Suspended', 'Sleeping', 'Finished');
     122  MicroThreadStateText: array[TMicroThreadState] of string = ('Waiting',
     123    'Running', 'Blocked', 'Suspended', 'Sleeping');
    89124
    90125implementation
    91126
     127{ TMicroThreadMethod }
     128
     129procedure TMicroThreadMethod.Execute;
     130begin
     131  inherited Execute;
     132  Method(Self);
     133end;
     134
    92135
    93136{ TMicroThread }
    94137
     138procedure TMicroThread.Execute;
     139begin
     140
     141end;
     142
    95143procedure TMicroThread.Yield;
    96144begin
    97145  Scheduler.Yield(Self);
     146end;
     147
     148procedure TMicroThread.WaitFor;
     149begin
     150  while not FFinished do begin
     151    Sleep(1);
     152  end;
    98153end;
    99154
    … …  
    105160end;
    106161
    107 constructor TMicroThread.Create;
    108 begin
    109   FStackSize := $10000;
     162function TMicroThread.WaitForSignal(Signal: TEvent): TWaitResult;
     163begin
     164  repeat
     165    Result := Signal.WaitFor(1);
     166    Sleep(1);
     167  until Result <> wrTimeout;
     168end;
     169
     170constructor TMicroThread.Create(CreateSuspended: Boolean;
     171  const StackSize: SizeUInt = DefaultStackSize);
     172begin
     173  FStackSize := StackSize;
    110174  FStack := GetMem(FStackSize);
    111175  FBasePointer := FStack + FStackSize;
    112176  FStackPointer := FBasePointer - 20;
    113177  FExecutionTime := 0;
     178  FTerminated := False;
     179  if CreateSuspended then
     180    State := tsSuspended;
     181  FFreeOnTerminate := True;
     182end;
     183
     184procedure TMicroThread.Terminate;
     185begin
     186  FTerminated := True;
    114187end;
    115188
    116189destructor TMicroThread.Destroy;
    117190begin
     191  Terminate;
     192  WaitFor;
     193  // Microthread is finished, remove it from queue
     194  try
     195    Scheduler.Lock.Acquire;
     196    Scheduler.MicroThreads.Delete(Scheduler.MicroThreads.IndexOf(Self));
     197  finally
     198    Scheduler.Lock.Release;
     199  end;
    118200  FreeMem(FStack);
    119201  inherited Destroy;
     202end;
     203
     204procedure TMicroThread.Start;
     205begin
     206  State := tsWaiting;
     207end;
     208
     209procedure TMicroThread.Stop;
     210begin
     211  State := tsSuspended;
    120212end;
    121213
    … …  
    142234end;
    143235
    144 function TMicroThreadScheduler.Add(Name: string; Method: TStartEvent
    145   ): TMicroThread;
    146 var
    147   NewMicroThread: TMicroThread;
    148 begin
    149   NewMicroThread := TMicroThread.Create;
     236function TMicroThreadScheduler.Add(MicroThread: TMicroThread): Integer;
     237begin
     238  Inc(LastId);
     239  MicroThread.Scheduler := Self;
     240  MicroThread.Id := LastId;
     241  Result := MicroThreads.Add(MicroThread);
     242end;
     243
     244function TMicroThreadScheduler.AddMethod(Method: TMicroThreadEvent): Integer;
     245var
     246  NewMicroThread: TMicroThreadMethod;
     247begin
     248  NewMicroThread := TMicroThreadMethod.Create(False);
     249  NewMicroThread.Method := Method;
    150250  NewMicroThread.Scheduler := Self;
    151   NewMicroThread.Name := Name;
    152   NewMicroThread.Method := Method;
    153   Inc(LastId);
    154   NewMicroThread.Id := LastId;
    155   MicroThreads.Add(NewMicroThread);
     251  Result := Add(NewMicroThread);
    156252end;
    157253
    … …  
    161257  MicroThreads := TObjectList.Create;
    162258  ThreadPool := TThreadPool.Create;
    163   FFreeMicroThreadOnFinish := True;
    164259  {$IFDEF Windows}
    165260  QueryPerformanceFrequency(FFrequency);
    … …  
    235330      mov ebp, edx
    236331    end;
     332    CurrentMicroThread := nil;
    237333  end;
    238334
    … …  
    245341    if RoundRobinIndex >= MicroThreads.Count then
    246342      RoundRobinIndex := 0;
    247     while (I < MicroThreads.Count) and (TMicroThread(MicroThreads[RoundRobinIndex]).State <> tsReady) and
    248 (TMicroThread(MicroThreads[RoundRobinIndex]).State <> tsWaiting) do begin
     343    while (I < MicroThreads.Count) and
     344     (TMicroThread(MicroThreads[RoundRobinIndex]).State <> tsWaiting) do begin
    249345      // WakeUp sleeping threads
    250346      if (TMicroThread(MicroThreads[RoundRobinIndex]).State = tsSleeping) and
    … …  
    268364  if Assigned(FSelected) and (FExecutedCount < FExecuteCount) then begin
    269365    Inc(FExecutedCount);
     366    CurrentMicroThread := FSelected;
    270367    asm
    271368      // Store scheduler stack
    … …  
    276373      mov [eax].TMicroThreadScheduler.FMainBasePointer, edx
    277374    end;
    278     if FSelected.State = tsReady then begin
     375    if not FSelected.FExecuted then begin
     376      FSelected.FExecuted := True;
    279377      FSelected.State := tsRunning;
    280378      FSelected.FExecutionStartTime := Time;
    … …  
    293391        mov ebp, edx
    294392      end;
    295       StaticMicroThread.Method(StaticMicroThread);
     393      StaticMicroThread.Execute;
    296394      //FSelected.Method(FSelected);
    297395      StaticScheduler := StaticMicroThread.Scheduler;
    … …  
    307405      FSelected.FExecutionTime := FSelected.FExecutionTime +
    308406       (FSelected.FExecutionEndTime - FSelected.FExecutionStartTime);
    309       if FFreeMicroThreadOnFinish then begin
    310         // Microthread is finished, remove it from queue
    311         try
    312           Lock.Acquire;
    313           MicroThreads.Delete(MicroThreads.IndexOf(FSelected));
    314         finally
    315           Lock.Release;
    316         end;
    317       end else FSelected.State := tsFinished;
     407      FSelected.FFinished := True;
     408      if FSelected.FFreeOnTerminate then begin
     409        FSelected.Free;
     410      end;;
    318411    end else
    319412    if FSelected.State = tsWaiting then begin
    … …  
    348441end;
    349442
     443function TMicroThreadScheduler.GetThreadPoolSize: Integer;
     444begin
     445  Result := FThreadPoolSize;
     446end;
     447
     448procedure TMicroThreadScheduler.SetThreadPoolSize(const AValue: Integer);
     449begin
     450  FThreadPoolSize := AValue;
     451end;
     452
     453initialization
     454
     455MainScheduler := TMicroThreadScheduler.Create;
     456
     457finalization
     458
     459MainScheduler.Free;
     460
    350461end.
    351462
Note: See TracChangeset for help on using the changeset viewer.