Changeset 148 for MicroThreading


Ignore:
Timestamp:
Jan 26, 2011, 2:16:19 PM (14 years ago)
Author:
george
Message:
  • Modified: Not completed thread safe support.
Location:
MicroThreading
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • MicroThreading/Demo/Demo.lpi

    r147 r148  
    4242      </Item3>
    4343    </RequiredPackages>
    44     <Units Count="46">
     44    <Units Count="48">
    4545      <Unit0>
    4646        <Filename Value="Demo.lpr"/>
    … …  
    5050        <TopLine Value="1"/>
    5151        <CursorPos X="1" Y="15"/>
    52         <UsageCount Value="49"/>
     52        <UsageCount Value="53"/>
    5353      </Unit0>
    5454      <Unit1>
    5555        <Filename Value="UMainForm.pas"/>
    5656        <IsPartOfProject Value="True"/>
    57         <ComponentName Value="Form1"/>
     57        <ComponentName Value="MainForm"/>
    5858        <ResourceBaseClass Value="Form"/>
    5959        <UnitName Value="UMainForm"/>
    6060        <EditorIndex Value="0"/>
    6161        <WindowIndex Value="0"/>
    62         <TopLine Value="82"/>
    63         <CursorPos X="1" Y="95"/>
    64         <UsageCount Value="49"/>
     62        <TopLine Value="70"/>
     63        <CursorPos X="18" Y="80"/>
     64        <UsageCount Value="53"/>
    6565        <Loaded Value="True"/>
    6666        <LoadedDesigner Value="True"/>
    … …  
    6969        <Filename Value="../UMicroThreading.pas"/>
    7070        <UnitName Value="UMicroThreading"/>
    71         <EditorIndex Value="2"/>
    72         <WindowIndex Value="0"/>
    73         <TopLine Value="500"/>
    74         <CursorPos X="1" Y="517"/>
    75         <UsageCount Value="27"/>
     71        <IsVisibleTab Value="True"/>
     72        <EditorIndex Value="4"/>
     73        <WindowIndex Value="0"/>
     74        <TopLine Value="621"/>
     75        <CursorPos X="1" Y="621"/>
     76        <UsageCount Value="30"/>
    7677        <Loaded Value="True"/>
    7778      </Unit2>
    … …  
    237238      <Unit24>
    238239        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/sysutils/datih.inc"/>
    239         <EditorIndex Value="4"/>
     240        <EditorIndex Value="7"/>
    240241        <WindowIndex Value="0"/>
    241242        <TopLine Value="106"/>
    242243        <CursorPos X="10" Y="119"/>
    243         <UsageCount Value="16"/>
     244        <UsageCount Value="19"/>
    244245        <Loaded Value="True"/>
    245246      </Unit24>
    … …  
    297298      <Unit32>
    298299        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/classesh.inc"/>
    299         <EditorIndex Value="5"/>
     300        <EditorIndex Value="8"/>
    300301        <WindowIndex Value="0"/>
    301302        <TopLine Value="1504"/>
    302303        <CursorPos X="1" Y="1510"/>
    303         <UsageCount Value="13"/>
     304        <UsageCount Value="16"/>
    304305        <Loaded Value="True"/>
    305306      </Unit32>
    … …  
    327328      <Unit36>
    328329        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/classes.inc"/>
    329         <EditorIndex Value="6"/>
     330        <EditorIndex Value="9"/>
    330331        <WindowIndex Value="0"/>
    331332        <TopLine Value="109"/>
    332333        <CursorPos X="3" Y="111"/>
    333         <UsageCount Value="13"/>
     334        <UsageCount Value="16"/>
    334335        <Loaded Value="True"/>
    335336      </Unit36>
    336337      <Unit37>
    337338        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/inc/objpash.inc"/>
     339        <EditorIndex Value="1"/>
    338340        <WindowIndex Value="0"/>
    339341        <TopLine Value="181"/>
    340342        <CursorPos X="21" Y="194"/>
    341343        <UsageCount Value="13"/>
     344        <Loaded Value="True"/>
    342345      </Unit37>
    343346      <Unit38>
    … …  
    385388      <Unit44>
    386389        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/lcl/include/spinedit.inc"/>
    387         <EditorIndex Value="1"/>
     390        <EditorIndex Value="3"/>
    388391        <WindowIndex Value="0"/>
    389392        <TopLine Value="221"/>
    390393        <CursorPos X="1" Y="235"/>
    391         <UsageCount Value="10"/>
     394        <UsageCount Value="13"/>
    392395        <Loaded Value="True"/>
    393396      </Unit44>
    394397      <Unit45>
    395398        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/lcl/interfaces/win32/win32object.inc"/>
    396         <IsVisibleTab Value="True"/>
    397         <EditorIndex Value="3"/>
     399        <EditorIndex Value="6"/>
    398400        <WindowIndex Value="0"/>
    399401        <TopLine Value="387"/>
    400402        <CursorPos X="1" Y="400"/>
    401         <UsageCount Value="10"/>
     403        <UsageCount Value="13"/>
    402404        <Loaded Value="True"/>
    403405      </Unit45>
     406      <Unit46>
     407        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/wininc/struct.inc"/>
     408        <EditorIndex Value="5"/>
     409        <WindowIndex Value="0"/>
     410        <TopLine Value="6081"/>
     411        <CursorPos X="6" Y="6094"/>
     412        <UsageCount Value="13"/>
     413        <Loaded Value="True"/>
     414      </Unit46>
     415      <Unit47>
     416        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/inc/objpas.inc"/>
     417        <EditorIndex Value="2"/>
     418        <WindowIndex Value="0"/>
     419        <TopLine Value="160"/>
     420        <CursorPos X="12" Y="163"/>
     421        <UsageCount Value="10"/>
     422        <Loaded Value="True"/>
     423      </Unit47>
    404424    </Units>
    405425    <JumpHistory Count="30" HistoryIndex="29">
    406426      <Position1>
    407427        <Filename Value="../UMicroThreading.pas"/>
    408         <Caret Line="579" Column="1" TopLine="566"/>
     428        <Caret Line="551" Column="1" TopLine="537"/>
    409429      </Position1>
    410430      <Position2>
    411431        <Filename Value="../UMicroThreading.pas"/>
    412         <Caret Line="580" Column="1" TopLine="566"/>
     432        <Caret Line="552" Column="1" TopLine="537"/>
    413433      </Position2>
    414434      <Position3>
    415435        <Filename Value="../UMicroThreading.pas"/>
    416         <Caret Line="581" Column="1" TopLine="566"/>
     436        <Caret Line="555" Column="1" TopLine="537"/>
    417437      </Position3>
    418438      <Position4>
    419439        <Filename Value="../UMicroThreading.pas"/>
    420         <Caret Line="582" Column="1" TopLine="566"/>
     440        <Caret Line="558" Column="1" TopLine="537"/>
    421441      </Position4>
    422442      <Position5>
    423443        <Filename Value="../UMicroThreading.pas"/>
    424         <Caret Line="583" Column="1" TopLine="566"/>
     444        <Caret Line="563" Column="1" TopLine="540"/>
    425445      </Position5>
    426446      <Position6>
    427447        <Filename Value="../UMicroThreading.pas"/>
    428         <Caret Line="584" Column="1" TopLine="566"/>
     448        <Caret Line="623" Column="1" TopLine="610"/>
    429449      </Position6>
    430450      <Position7>
    431451        <Filename Value="../UMicroThreading.pas"/>
    432         <Caret Line="142" Column="26" TopLine="125"/>
     452        <Caret Line="550" Column="1" TopLine="537"/>
    433453      </Position7>
    434454      <Position8>
    435         <Filename Value="UMainForm.pas"/>
    436         <Caret Line="95" Column="17" TopLine="87"/>
     455        <Filename Value="../UMicroThreading.pas"/>
     456        <Caret Line="551" Column="1" TopLine="537"/>
    437457      </Position8>
    438458      <Position9>
    439459        <Filename Value="../UMicroThreading.pas"/>
    440         <Caret Line="512" Column="3" TopLine="507"/>
     460        <Caret Line="552" Column="1" TopLine="537"/>
    441461      </Position9>
    442462      <Position10>
    443         <Filename Value="UMainForm.pas"/>
    444         <Caret Line="95" Column="17" TopLine="87"/>
     463        <Filename Value="../UMicroThreading.pas"/>
     464        <Caret Line="556" Column="1" TopLine="537"/>
    445465      </Position10>
    446466      <Position11>
    447467        <Filename Value="../UMicroThreading.pas"/>
    448         <Caret Line="513" Column="1" TopLine="507"/>
     468        <Caret Line="558" Column="1" TopLine="537"/>
    449469      </Position11>
    450470      <Position12>
    451471        <Filename Value="../UMicroThreading.pas"/>
    452         <Caret Line="514" Column="1" TopLine="507"/>
     472        <Caret Line="561" Column="1" TopLine="539"/>
    453473      </Position12>
    454474      <Position13>
    455475        <Filename Value="../UMicroThreading.pas"/>
    456         <Caret Line="327" Column="3" TopLine="323"/>
     476        <Caret Line="559" Column="3" TopLine="543"/>
    457477      </Position13>
    458478      <Position14>
    459479        <Filename Value="../UMicroThreading.pas"/>
    460         <Caret Line="513" Column="1" TopLine="500"/>
     480        <Caret Line="564" Column="1" TopLine="543"/>
    461481      </Position14>
    462482      <Position15>
    463483        <Filename Value="../UMicroThreading.pas"/>
    464         <Caret Line="514" Column="1" TopLine="500"/>
     484        <Caret Line="562" Column="1" TopLine="543"/>
    465485      </Position15>
    466486      <Position16>
    467487        <Filename Value="../UMicroThreading.pas"/>
    468         <Caret Line="516" Column="1" TopLine="500"/>
     488        <Caret Line="563" Column="1" TopLine="543"/>
    469489      </Position16>
    470490      <Position17>
    471491        <Filename Value="../UMicroThreading.pas"/>
    472         <Caret Line="517" Column="1" TopLine="500"/>
     492        <Caret Line="564" Column="1" TopLine="543"/>
    473493      </Position17>
    474494      <Position18>
    475495        <Filename Value="../UMicroThreading.pas"/>
    476         <Caret Line="328" Column="1" TopLine="315"/>
     496        <Caret Line="562" Column="1" TopLine="543"/>
    477497      </Position18>
    478498      <Position19>
    479499        <Filename Value="../UMicroThreading.pas"/>
    480         <Caret Line="330" Column="1" TopLine="315"/>
     500        <Caret Line="563" Column="1" TopLine="543"/>
    481501      </Position19>
    482502      <Position20>
    483503        <Filename Value="../UMicroThreading.pas"/>
    484         <Caret Line="331" Column="1" TopLine="315"/>
     504        <Caret Line="564" Column="1" TopLine="543"/>
    485505      </Position20>
    486506      <Position21>
    487507        <Filename Value="../UMicroThreading.pas"/>
    488         <Caret Line="332" Column="1" TopLine="315"/>
     508        <Caret Line="562" Column="1" TopLine="543"/>
    489509      </Position21>
    490510      <Position22>
    491         <Filename Value="UMainForm.pas"/>
    492         <Caret Line="95" Column="17" TopLine="87"/>
     511        <Filename Value="../UMicroThreading.pas"/>
     512        <Caret Line="563" Column="1" TopLine="543"/>
    493513      </Position22>
    494514      <Position23>
    495         <Filename Value="UMainForm.pas"/>
    496         <Caret Line="235" Column="19" TopLine="224"/>
     515        <Filename Value="../UMicroThreading.pas"/>
     516        <Caret Line="564" Column="1" TopLine="543"/>
    497517      </Position23>
    498518      <Position24>
    499519        <Filename Value="../UMicroThreading.pas"/>
    500         <Caret Line="513" Column="1" TopLine="500"/>
     520        <Caret Line="562" Column="1" TopLine="543"/>
    501521      </Position24>
    502522      <Position25>
    503         <Filename Value="UMainForm.pas"/>
    504         <Caret Line="244" Column="9" TopLine="224"/>
     523        <Filename Value="../UMicroThreading.pas"/>
     524        <Caret Line="564" Column="1" TopLine="543"/>
    505525      </Position25>
    506526      <Position26>
    507         <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/lcl/interfaces/win32/win32object.inc"/>
    508         <Caret Line="400" Column="1" TopLine="387"/>
     527        <Filename Value="../UMicroThreading.pas"/>
     528        <Caret Line="141" Column="44" TopLine="127"/>
    509529      </Position26>
    510530      <Position27>
    511531        <Filename Value="../UMicroThreading.pas"/>
    512         <Caret Line="517" Column="1" TopLine="500"/>
     532        <Caret Line="580" Column="25" TopLine="568"/>
    513533      </Position27>
    514534      <Position28>
    515         <Filename Value="UMainForm.pas"/>
    516         <Caret Line="95" Column="1" TopLine="82"/>
     535        <Filename Value="../UMicroThreading.pas"/>
     536        <Caret Line="151" Column="27" TopLine="134"/>
    517537      </Position28>
    518538      <Position29>
    519539        <Filename Value="../UMicroThreading.pas"/>
    520         <Caret Line="517" Column="1" TopLine="500"/>
     540        <Caret Line="150" Column="47" TopLine="135"/>
    521541      </Position29>
    522542      <Position30>
    523         <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/lcl/interfaces/win32/win32object.inc"/>
    524         <Caret Line="394" Column="30" TopLine="387"/>
     543        <Filename Value="../UMicroThreading.pas"/>
     544        <Caret Line="118" Column="59" TopLine="112"/>
    525545      </Position30>
    526546    </JumpHistory>
    … …  
    535555      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
    536556    </SearchPaths>
     557    <CodeGeneration>
     558      <Checks>
     559        <IOChecks Value="True"/>
     560        <RangeChecks Value="True"/>
     561        <OverflowChecks Value="True"/>
     562        <StackChecks Value="True"/>
     563      </Checks>
     564      <VerifyObjMethodCallValidity Value="True"/>
     565    </CodeGeneration>
    537566    <Linking>
     567      <Debugging>
     568        <UseHeaptrc Value="True"/>
     569      </Debugging>
    538570      <Options>
    539571        <Win32>
    … …  
    543575    </Linking>
    544576    <Other>
     577      <CompilerMessages>
     578        <UseMsgFile Value="True"/>
     579      </CompilerMessages>
    545580      <CompilerPath Value="$(CompPath)"/>
    546581    </Other>
    … …  
    557592      </Item2>
    558593      <Item3>
    559         <Source Value="umainform.pas"/>
    560         <Line Value="65"/>
     594        <Source Value="../Coroutine.pas"/>
     595        <Line Value="257"/>
    561596      </Item3>
    562597      <Item4>
    563598        <Source Value="../Coroutine.pas"/>
    564         <Line Value="257"/>
     599        <Line Value="145"/>
    565600      </Item4>
    566601      <Item5>
    567         <Source Value="../Coroutine.pas"/>
    568         <Line Value="145"/>
     602        <Source Value="../UMicroThreading.pas"/>
     603        <Line Value="554"/>
    569604      </Item5>
    570605    </BreakPoints>

  • MicroThreading/Demo/Demo.lpr

    r145 r148  
    1515begin
    1616  Application.Initialize;
    17   Application.CreateForm(TForm1, Form1);
     17  Application.CreateForm(TMainForm, MainForm);
    1818  Application.Run;
    1919end.

  • MicroThreading/Demo/UMainForm.lfm

    r147 r148  
    1 object Form1: TForm1
    2   Left = 235
     1object MainForm: TMainForm
     2  Left = 263
    33  Height = 510
    4   Top = 44
     4  Top = 156
    55  Width = 798
    66  Caption = 'MicroThreading demo'
    … …  
    1111  OnDestroy = FormDestroy
    1212  LCLVersion = '0.9.31'
    13   object Button1: TButton
     13  object ButtonSchedulerStartStop: TButton
    1414    Left = 9
    1515    Height = 25
    … …  
    1717    Width = 103
    1818    Caption = 'Start scheduler'
    19     OnClick = Button1Click
     19    OnClick = ButtonSchedulerStartStopClick
    2020    TabOrder = 0
    2121  end
    … …  
    8484    TabOrder = 3
    8585  end
    86   object Button3: TButton
    87     Left = 10
    88     Height = 25
    89     Top = 208
    90     Width = 75
    91     Caption = 'Coroutine'
    92     OnClick = Button3Click
    93     TabOrder = 4
    94   end
    9586  object Label2: TLabel
    9687    Left = 10
    … …  
    10192    ParentColor = False
    10293  end
    103   object Button4: TButton
     94  object ButtonAddWorkers: TButton
    10495    Left = 10
    10596    Height = 25
    106     Top = 48
    107     Width = 88
    108     Caption = 'Start workers'
    109     OnClick = Button4Click
    110     TabOrder = 5
     97    Top = 72
     98    Width = 104
     99    Caption = 'Add workers'
     100    OnClick = ButtonAddWorkersClick
     101    TabOrder = 4
    111102  end
    112103  object SpinEdit1: TSpinEdit
    113     Left = 216
     104    Left = 224
    114105    Height = 21
    115     Top = 48
    116     Width = 82
     106    Top = 76
     107    Width = 74
    117108    MaxValue = 100000
    118109    MinValue = 1
    119     TabOrder = 6
     110    TabOrder = 5
    120111    Value = 200
    121112  end
    122   object Button5: TButton
     113  object ButtonGetMaxThread: TButton
    123114    Left = 168
    124115    Height = 25
    … …  
    126117    Width = 131
    127118    Caption = 'Get max TThread count'
    128     OnClick = Button5Click
     119    OnClick = ButtonGetMaxThreadClick
     120    TabOrder = 6
     121  end
     122  object ButtonShowThreadId: TButton
     123    Left = 40
     124    Height = 25
     125    Top = 160
     126    Width = 123
     127    Caption = 'Show thread id'
     128    OnClick = ButtonShowThreadIdClick
    129129    TabOrder = 7
    130130  end
    131   object Button6: TButton
    132     Left = 88
    133     Height = 25
    134     Top = 160
    135     Width = 75
    136     Caption = 'Button6'
    137     OnClick = Button6Click
    138     TabOrder = 8
    139   end
    140131  object SpinEdit2: TSpinEdit
    141     Left = 216
     132    Left = 224
    142133    Height = 21
    143134    Top = 13
    144     Width = 82
    145     TabOrder = 9
     135    Width = 74
     136    OnChange = SpinEdit2Change
     137    TabOrder = 8
    146138    Value = 1
    147139  end
    … …  
    155147  end
    156148  object Label4: TLabel
    157     Left = 104
     149    Left = 120
    158150    Height = 14
    159     Top = 48
     151    Top = 79
    160152    Width = 92
    161153    Caption = 'Microthread count:'
    162154    ParentColor = False
     155  end
     156  object Label5: TLabel
     157    Left = 120
     158    Height = 14
     159    Top = 40
     160    Width = 117
     161    Caption = 'Logical processor count:'
     162    ParentColor = False
     163  end
     164  object Label6: TLabel
     165    Left = 248
     166    Height = 14
     167    Top = 40
     168    Width = 13
     169    Caption = '    '
     170    ParentColor = False
     171  end
     172  object ButtonClearMicroThreads: TButton
     173    Left = 10
     174    Height = 25
     175    Top = 102
     176    Width = 104
     177    Caption = 'Clear microthreads'
     178    OnClick = ButtonClearMicroThreadsClick
     179    TabOrder = 9
    163180  end
    164181  object Timer1: TTimer

  • MicroThreading/Demo/UMainForm.pas

    r147 r148  
    1111type
    1212
    13   { TTest }
    14 
    15   TTest = class(TCoroutine)
    16     procedure Execute; override;
    17   end;
    18 
    19   { TForm1 }
    20 
    21   TForm1 = class(TForm)
    22     Button1: TButton;
     13  { TMainForm }
     14
     15  TMainForm = class(TForm)
     16    ButtonSchedulerStartStop: TButton;
    2317    Button2: TButton;
    24     Button3: TButton;
    25     Button4: TButton;
    26     Button5: TButton;
    27     Button6: TButton;
     18    ButtonAddWorkers: TButton;
     19    ButtonGetMaxThread: TButton;
     20    ButtonShowThreadId: TButton;
     21    ButtonClearMicroThreads: TButton;
    2822    Label1: TLabel;
    2923    Label2: TLabel;
    3024    Label3: TLabel;
    3125    Label4: TLabel;
     26    Label5: TLabel;
     27    Label6: TLabel;
    3228    ListView1: TListView;
    3329    Memo1: TMemo;
    … …  
    3531    SpinEdit2: TSpinEdit;
    3632    Timer1: TTimer;
    37     procedure Button1Click(Sender: TObject);
     33    procedure ButtonSchedulerStartStopClick(Sender: TObject);
    3834    procedure Button2Click(Sender: TObject);
    39     procedure Button3Click(Sender: TObject);
    40     procedure Button4Click(Sender: TObject);
    41     procedure Button5Click(Sender: TObject);
    42     procedure Button6Click(Sender: TObject);
     35    procedure ButtonAddWorkersClick(Sender: TObject);
     36    procedure ButtonGetMaxThreadClick(Sender: TObject);
     37    procedure ButtonShowThreadIdClick(Sender: TObject);
     38    procedure ButtonClearMicroThreadsClick(Sender: TObject);
    4339    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    4440    procedure FormCreate(Sender: TObject);
    4541    procedure FormDestroy(Sender: TObject);
    4642    procedure ListView1Data(Sender: TObject; Item: TListItem);
     43    procedure SpinEdit2Change(Sender: TObject);
    4744    procedure Timer1Timer(Sender: TObject);
    4845  private
    … …  
    5047  public
    5148    Scheduler: TMicroThreadScheduler;
    52     Test: TTest;
    53   end;
    54 
    55 var
    56   Form1: TForm1;
     49  end;
     50
     51var
     52  MainForm: TMainForm;
    5753
    5854implementation
    … …  
    6056{ TTest }
    6157
    62 procedure TTest.Execute;
    63 var
    64   I: Integer;
    65 begin
    66 //  for I := 0 to 100 do begin
    67     Form1.Memo1.Lines.Add(IntToStr(I));
    68       Sleep(10);
    69       //raise Exception.Create('Test');
    70       Yield;
    71 
    72 //  end;
    73 end;
    74 
    7558{$R *.lfm}
    7659
    77 { TForm1 }
    78 
    79 procedure TForm1.FormCreate(Sender: TObject);
     60{ TMainForm }
     61
     62procedure TMainForm.FormCreate(Sender: TObject);
    8063begin
    8164  Scheduler := TMicroThreadScheduler.Create;
    82   Test := TTest.Create;
    8365  DoubleBuffered := True;
    8466  ListView1.DoubleBuffered := True;
    85 end;
    86 
    87 procedure TForm1.Button1Click(Sender: TObject);
    88 var
    89   I: Integer;
    90 begin
    91   if Button1.Caption = 'Start scheduler' then begin
    92     Button1.Caption := 'Stop scheduler';
     67  Label6.Caption := IntToStr(Scheduler.GetCPUCoreCount);
     68end;
     69
     70procedure TMainForm.ButtonSchedulerStartStopClick(Sender: TObject);
     71var
     72  I: Integer;
     73begin
     74  if ButtonSchedulerStartStop.Caption = 'Start scheduler' then begin
     75    ButtonSchedulerStartStop.Caption := 'Stop scheduler';
    9376    Memo1.Clear;
    94     Scheduler.ThreadPoolSize := SpinEdit2.Value;
    95     Scheduler.Start;
     77    Scheduler.Active := True;
    9678  end else begin
    97     Button1.Caption := 'Start scheduler';
    98     Scheduler.Stop;
    99     Scheduler.ThreadPoolSize := 0;
    100   end;
    101 end;
    102 
    103 procedure TForm1.Button2Click(Sender: TObject);
     79    ButtonSchedulerStartStop.Caption := 'Start scheduler';
     80    Scheduler.Active := False;
     81  end;
     82end;
     83
     84procedure TMainForm.Button2Click(Sender: TObject);
    10485const
    10586  MaxBlock = MaxInt - $f;
    … …  
    154135end;
    155136
    156 procedure TForm1.Button3Click(Sender: TObject);
    157 begin
    158   Test.Invoke;
    159 end;
    160 
    161 procedure TForm1.Button4Click(Sender: TObject);
    162 var
    163   I: Integer;
    164 begin
    165   Scheduler.MicroThreads.Clear;
     137procedure TMainForm.ButtonAddWorkersClick(Sender: TObject);
     138var
     139  I: Integer;
     140begin
     141  //Scheduler.FMicroThreads.Clear;
    166142  for I := 0 to SpinEdit1.Value do
    167143    Scheduler.AddMethod(Worker);
    168144end;
    169145
    170 procedure TForm1.Button5Click(Sender: TObject);
     146procedure TMainForm.ButtonGetMaxThreadClick(Sender: TObject);
    171147var
    172148  NewThread: TThread;
    … …  
    185161end;
    186162
    187 procedure TForm1.Button6Click(Sender: TObject);
     163procedure TMainForm.ButtonShowThreadIdClick(Sender: TObject);
    188164begin
    189165  ShowMessage(IntToStr(GetThreadID));
    190166end;
    191167
    192 procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
    193 begin
    194   Scheduler.Stop;
    195 end;
    196 
    197 procedure TForm1.FormDestroy(Sender: TObject);
    198 begin
    199   Test.Free;
     168procedure TMainForm.ButtonClearMicroThreadsClick(Sender: TObject);
     169begin
     170  try
     171    Scheduler.MicroThreadsLock.Acquire;
     172    Scheduler.MicroThreads.Clear;
     173  finally
     174    Scheduler.MicroThreadsLock.Release;
     175  end;
     176end;
     177
     178procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
     179begin
     180end;
     181
     182procedure TMainForm.FormDestroy(Sender: TObject);
     183begin
    200184  Scheduler.Free;
    201185end;
    202186
    203 procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
     187procedure TMainForm.ListView1Data(Sender: TObject; Item: TListItem);
    204188begin
    205189  try
    206     Scheduler.Lock.Acquire;
     190    Scheduler.MicroThreadsLock.Acquire;
    207191    if Item.Index < Scheduler.MicroThreads.Count then
    208192    with TMicroThread(Scheduler.MicroThreads[Item.Index]) do begin
    … …  
    216200    end;
    217201  finally
    218     Scheduler.Lock.Release;
    219   end;
    220 end;
    221 
    222 procedure TForm1.Timer1Timer(Sender: TObject);
     202    Scheduler.MicroThreadsLock.Release;
     203  end;
     204end;
     205
     206procedure TMainForm.SpinEdit2Change(Sender: TObject);
     207begin
     208  Scheduler.ThreadPoolSize := SpinEdit2.Value;
     209end;
     210
     211procedure TMainForm.Timer1Timer(Sender: TObject);
    223212begin
    224213  ListView1.Items.Count := Scheduler.MicroThreadCount;
    … …  
    229218end;
    230219
    231 procedure TForm1.Worker(MicroThread: TMicroThread);
     220procedure TMainForm.Worker(MicroThread: TMicroThread);
    232221var
    233222  I: Integer;

  • MicroThreading/UMicroThreading.pas

    r147 r148  
    105105    FTerminated: Boolean;
    106106    FTempPointer: Pointer;
     107    FCurrentMicroThread: TMicroThread;
     108    FScheduler: TMicroThreadScheduler;
    107109    function Execute(Count: Integer): Integer;
    108110  public
    109     Scheduler: TMicroThreadScheduler;
    110     CurrentMicroThread: TMicroThread;
    111111    procedure Yield;
    112112    constructor Create;
    113113    destructor Destroy; override;
    114   end;
     114    property Scheduler: TMicroThreadScheduler read FScheduler;
     115    property CurrentMicroThread: TMicroThread read FCurrentMicroThread;
     116  end;
     117
     118  TMicroThreadSchedulerState = (ssStopped, ssRunning, ssTerminating);
    115119
    116120  { TMicroThreadScheduler }
    … …  
    118122  TMicroThreadScheduler = class
    119123  private
    120     ThreadPool: TThreadPool;
    121     RoundRobinIndex: Integer;
     124    FActive: Boolean;
     125    FThreadPool: TThreadPool;
     126    FThreadPoolLock: TCriticalSection;
     127    FThreadPoolSize: Integer;
     128    FRoundRobinIndex: Integer;
    122129    FLastId: Integer;
    123130    FFrequency: Int64;
     131    FTerminate: Boolean;
    124132    FTerminated: Boolean;
     133    FMicroThreads: TObjectList; // TList<TMicroThread>
     134    FMainThreadManager: TMicroThreadManager;
     135    FMicroThreadsLock: TCriticalSection;
     136    FState: TMicroThreadSchedulerState;
    125137    function GetMicroThreadCount: Integer;
    126138    function GetThreadPoolSize: Integer;
     139    procedure SetActive(const AValue: Boolean);
    127140    procedure SetThreadPoolSize(const AValue: Integer);
    128141    function GetNextMicroThread: TMicroThread;
     142    procedure WaitFor;
     143    procedure Start;
     144    procedure Stop;
     145    function ThreadPoolTerminated: Boolean;
    129146  public
    130     MainThreadManager: TMicroThreadManager;
    131     MicroThreads: TObjectList; // TList<TMicroThread>
    132     Lock: TCriticalSection;
    133147    function GetNow: TDateTime;
    134148    function Add(MicroThread: TMicroThread): Integer;
    135149    function AddMethod(Method: TMicroThreadEvent): Integer;
     150    function GetCPUCoreCount: Integer;
    136151    constructor Create;
    137152    destructor Destroy; override;
    138     procedure Start;
    139     procedure Stop;
    140153    property MicroThreadCount: Integer read GetMicroThreadCount;
    141154    property ThreadPoolSize: Integer read GetThreadPoolSize
    142155      write SetThreadPoolSize;
     156    property MicroThreads: TObjectList read FMicroThreads;
     157    property MicroThreadsLock: TCriticalSection read FMicroThreadsLock;
     158    property MainThreadManager: TMicroThreadManager read FMainThreadManager;
     159    property Active: Boolean read FActive write SetActive;
    143160  end;
    144161
    … …  
    167184  with MainScheduler do begin
    168185    try
    169       Lock.Acquire;
     186      FMicroThreadsLock.Acquire;
    170187      I := 0;
    171       while (I < MicroThreads.Count) and
    172         not ((CurrentStack >= TMicroThread(MicroThreads[I]).FStack) and
    173         (CurrentStack <= (TMicroThread(MicroThreads[I]).FStack +
    174         TMicroThread(MicroThreads[I]).FStackSize))) do Inc(I);
    175       if I < MicroThreads.Count then begin
    176         Result := TMicroThread(MicroThreads[I]).FId;
     188      while (I < FMicroThreads.Count) and
     189        not ((CurrentStack >= TMicroThread(FMicroThreads[I]).FStack) and
     190        (CurrentStack <= (TMicroThread(FMicroThreads[I]).FStack +
     191        TMicroThread(FMicroThreads[I]).FStackSize))) do Inc(I);
     192      if I < FMicroThreads.Count then begin
     193        Result := TMicroThread(FMicroThreads[I]).FId;
    177194      end else Result := -1;
    178195    finally
    179       Lock.Release;
     196      FMicroThreadsLock.Release;
    180197    end;
    181198  end;
    … …  
    199216  CurrentTime: TDateTime;
    200217begin
    201   CurrentTime := Scheduler.GetNow;
    202   if Assigned(CurrentMicroThread) then begin
    203     CurrentMicroThread.FExecutionEndTime := CurrentTime;
    204     CurrentMicroThread.FExecutionTime := CurrentMicroThread.FExecutionTime +
    205       (CurrentMicroThread.FExecutionEndTime - CurrentMicroThread.FExecutionStartTime);
    206     if CurrentMicroThread.FState = tsRunning then
    207       CurrentMicroThread.FState := tsWaiting;
    208     StaticMicroThread := CurrentMicroThread;
     218  CurrentTime := FScheduler.GetNow;
     219  if Assigned(FCurrentMicroThread) then begin
     220    FCurrentMicroThread.FExecutionEndTime := CurrentTime;
     221    FCurrentMicroThread.FExecutionTime := FCurrentMicroThread.FExecutionTime +
     222      (FCurrentMicroThread.FExecutionEndTime - FCurrentMicroThread.FExecutionStartTime);
     223    if FCurrentMicroThread.FState = tsRunning then
     224      FCurrentMicroThread.FState := tsWaiting;
     225    StaticMicroThread := FCurrentMicroThread;
    209226    asm
    210227      // Store microthread stack
    … …  
    215232      mov [eax].TMicroThread.FBasePointer, edx
    216233    end;
    217     StaticManager := CurrentMicroThread.FManager;
     234    StaticManager := FCurrentMicroThread.FManager;
    218235    asm
    219       // Restore scheduler stack
     236      // Restore FScheduler stack
    220237      mov eax, StaticManager  // Self is invalid before BP restore
    221238      mov edx, [eax].TMicroThreadManager.FStackPointer
    … …  
    224241      mov ebp, edx
    225242    end;
    226     CurrentMicroThread.FManager := nil;
    227     CurrentMicroThread := nil;
    228   end;
    229 
    230   CurrentMicroThread := Scheduler.GetNextMicroThread;
    231 
    232   if Assigned(CurrentMicroThread) and (FExecutedCount < FExecuteCount) then begin
    233     CurrentMicroThread.FManager := Self;
     243    FCurrentMicroThread.FManager := nil;
     244    FCurrentMicroThread := nil;
     245  end;
     246
     247  FCurrentMicroThread := FScheduler.GetNextMicroThread;
     248
     249  if Assigned(FCurrentMicroThread) and (FExecutedCount < FExecuteCount) then begin
     250    FCurrentMicroThread.FManager := Self;
    234251    Inc(FExecutedCount);
    235252    asm
    236       // Store scheduler stack
     253      // Store FScheduler stack
    237254      mov eax, Self
    238255      mov edx, esp
    … …  
    241258      mov [eax].TMicroThreadManager.FBasePointer, edx
    242259    end;
    243     if not CurrentMicroThread.FExecuted then begin
    244       CurrentMicroThread.FExecuted := True;
    245       CurrentMicroThread.FState := tsRunning;
    246       CurrentMicroThread.FExecutionStartTime := CurrentTime;
    247       StaticMicroThread := CurrentMicroThread;
     260    if not FCurrentMicroThread.FExecuted then begin
     261      FCurrentMicroThread.FExecuted := True;
     262      FCurrentMicroThread.FState := tsRunning;
     263      FCurrentMicroThread.FExecutionStartTime := CurrentTime;
     264      StaticMicroThread := FCurrentMicroThread;
    248265      asm
    249266        // Restore microthread stack
    … …  
    260277      end;
    261278      //FSelected.Method(FSelected);
    262       StaticManager := CurrentMicroThread.FManager;
     279      StaticManager := FCurrentMicroThread.FManager;
    263280      asm
    264         // Restore scheduler stack
     281        // Restore FScheduler stack
    265282        mov eax, StaticManager // Self is invalid before BP restore
    266283        mov edx, [eax].TMicroThreadManager.FStackPointer
    … …  
    269286        mov ebp, edx
    270287      end;
    271       CurrentMicroThread.FManager := nil;
    272       CurrentMicroThread.FExecutionEndTime := CurrentTime;
    273       CurrentMicroThread.FExecutionTime := CurrentMicroThread.FExecutionTime +
    274        (CurrentMicroThread.FExecutionEndTime - CurrentMicroThread.FExecutionStartTime);
    275       CurrentMicroThread.FFinished := True;
    276       if CurrentMicroThread.FFreeOnTerminate then begin
     288      FCurrentMicroThread.FManager := nil;
     289      FCurrentMicroThread.FExecutionEndTime := CurrentTime;
     290      FCurrentMicroThread.FExecutionTime := FCurrentMicroThread.FExecutionTime +
     291       (FCurrentMicroThread.FExecutionEndTime - FCurrentMicroThread.FExecutionStartTime);
     292      FCurrentMicroThread.FFinished := True;
     293      if FCurrentMicroThread.FFreeOnTerminate then begin
    277294        // Microthread is finished, remove it from queue
    278         with Scheduler do
     295        with FScheduler do
    279296        try
    280           Lock.Acquire;
    281           MicroThreads.Delete(MicroThreads.IndexOf(CurrentMicroThread));
     297          FMicroThreadsLock.Acquire;
     298          FMicroThreads.Delete(FMicroThreads.IndexOf(FCurrentMicroThread));
    282299        finally
    283           Lock.Release;
     300          FMicroThreadsLock.Release;
    284301        end;
    285302      end;
    286       CurrentMicroThread := nil;
     303      FCurrentMicroThread := nil;
    287304    end else
    288     if CurrentMicroThread.State = tsWaiting then begin
     305    if FCurrentMicroThread.State = tsWaiting then begin
    289306      // Execute selected thread
    290       CurrentMicroThread.FState := tsRunning;
    291       CurrentMicroThread.FExecutionStartTime := CurrentTime;
    292       FTempPointer := CurrentMicroThread.FStackPointer;
     307      FCurrentMicroThread.FState := tsRunning;
     308      FCurrentMicroThread.FExecutionStartTime := CurrentTime;
     309      FTempPointer := FCurrentMicroThread.FStackPointer;
    293310      asm
    294311        // Restore microthread stack
    … …  
    297314        mov esp, edx
    298315      end;
    299       FTempPointer := CurrentMicroThread.FBasePointer;
     316      FTempPointer := FCurrentMicroThread.FBasePointer;
    300317      asm
    301318        mov eax, Self
    … …  
    305322    end;
    306323  end else begin
    307     CurrentMicroThread := nil;
     324    FCurrentMicroThread := nil;
    308325  end;
    309326end;
    … …  
    311328constructor TMicroThreadManager.Create;
    312329begin
    313   CurrentMicroThread := nil;
     330  FCurrentMicroThread := nil;
    314331end;
    315332
    … …  
    469486  MicroThread.FScheduler := Self;
    470487  MicroThread.FId := FLastId;
    471   Result := MicroThreads.Add(MicroThread);
     488  Result := FMicroThreads.Add(MicroThread);
    472489end;
    473490
    … …  
    482499end;
    483500
     501function TMicroThreadScheduler.GetCPUCoreCount: Integer;
     502var
     503  SystemInfo: _SYSTEM_INFO;
     504begin
     505  GetSystemInfo(SystemInfo);
     506  Result := SystemInfo.dwNumberOfProcessors;
     507end;
     508
    484509constructor TMicroThreadScheduler.Create;
    485510begin
    486   Lock := TCriticalSection.Create;
    487   MicroThreads := TObjectList.Create;
    488   ThreadPool := TThreadPool.Create;
     511  FTerminated := True;
     512  FMicroThreadsLock := TCriticalSection.Create;
     513  FMicroThreads := TObjectList.Create;
     514  FThreadPool := TThreadPool.Create;
     515  FThreadPoolLock := TCriticalSection.Create;
    489516  {$IFDEF Windows}
    490517  QueryPerformanceFrequency(FFrequency);
    491518  {$ENDIF}
    492   RoundRobinIndex := -1;
    493   MainThreadManager := TMicroThreadManager.Create;
    494   MainThreadManager.Scheduler := Self;
     519  FRoundRobinIndex := -1;
     520  FMainThreadManager := TMicroThreadManager.Create;
     521  FMainThreadManager.FScheduler := Self;
    495522end;
    496523
    497524destructor TMicroThreadScheduler.Destroy;
    498525begin
    499   MainThreadManager.Free;
    500   FTerminated := True;
    501   ThreadPool.Free;
    502   MicroThreads.Free;
    503   Lock.Free;
     526  Active := False;
     527  FMainThreadManager.Free;
     528  FThreadPool.Free;
     529  FMicroThreads.Free;
     530  FMicroThreadsLock.Free;
    504531  inherited Destroy;
    505532end;
    … …  
    511538begin
    512539  FTerminated := False;
    513   for I := 0 to ThreadPool.Count - 1 do
    514     TMicroThreadSchedulerPoolThread(ThreadPool[I]).Start;
     540  FTerminate := False;
     541  for I := 0 to FThreadPool.Count - 1 do
     542    TMicroThreadSchedulerPoolThread(FThreadPool[I]).Start;
    515543  repeat
    516     Executed := MainThreadManager.Execute(10);
     544    Executed := FMainThreadManager.Execute(10);
    517545    Application.ProcessMessages;
    518546    if Executed = 0 then Sleep(1);
    519   until FTerminated;
     547  until FTerminate;
     548  FTerminated := True;
    520549end;
    521550
    … …  
    524553  I: Integer;
    525554begin
    526   for I := 0 to ThreadPool.Count - 1 do
    527     TMicroThreadSchedulerPoolThread(ThreadPool[I]).Terminate;
    528   FTerminated := True;
     555  try
     556    FThreadPoolLock.Acquire;
     557    for I := 0 to FThreadPool.Count - 1 do begin
     558      TMicroThreadSchedulerPoolThread(FThreadPool[I]).Terminate;
     559    end;
     560  finally
     561    FThreadPoolLock.Release;
     562  end;
     563  FTerminate := True;
     564
     565  // Wait for all thread managers to finish
     566  repeat
     567    Application.ProcessMessages;
     568    Sleep(1);
     569  until FTerminated and (ThreadPoolSize = 0);
     570end;
     571
     572function TMicroThreadScheduler.ThreadPoolTerminated: Boolean;
     573var
     574  I: Integer;
     575begin
     576  try
     577    FThreadPoolLock.Acquire;
     578    I := 0;
     579    while (I < FThreadPool.Count) and
     580      (TMicroThreadSchedulerPoolThread(FThreadPool[I]).Terminated do
     581  finally
     582    FThreadPoolLock.Release;
     583  end;
    529584end;
    530585
    … …  
    537592  Result := nil;
    538593  try
    539     Lock.Acquire;
     594    FMicroThreadsLock.Acquire;
    540595    I := 0;
    541     Inc(RoundRobinIndex);
    542     if RoundRobinIndex >= MicroThreads.Count then
    543       RoundRobinIndex := 0;
    544     while (I < MicroThreads.Count) and
    545      (TMicroThread(MicroThreads[RoundRobinIndex]).State <> tsWaiting) do begin
     596    Inc(FRoundRobinIndex);
     597    if FRoundRobinIndex >= FMicroThreads.Count then
     598      FRoundRobinIndex := 0;
     599    while (I < FMicroThreads.Count) and
     600     (TMicroThread(FMicroThreads[FRoundRobinIndex]).State <> tsWaiting) do begin
    546601      // WakeUp sleeping threads
    547       if (TMicroThread(MicroThreads[RoundRobinIndex]).FState = tsSleeping) and
    548         (TMicroThread(MicroThreads[RoundRobinIndex]).FWakeupTime < CurrentTime) then
    549           TMicroThread(MicroThreads[RoundRobinIndex]).FState := tsWaiting else
     602      if (TMicroThread(FMicroThreads[FRoundRobinIndex]).FState = tsSleeping) and
     603        (TMicroThread(FMicroThreads[FRoundRobinIndex]).FWakeupTime < CurrentTime) then
     604          TMicroThread(FMicroThreads[FRoundRobinIndex]).FState := tsWaiting else
    550605      begin
    551606        // Go to next thread
    552607        Inc(I);
    553         Inc(RoundRobinIndex);
    554         if RoundRobinIndex >= MicroThreads.Count then
    555           RoundRobinIndex := 0;
     608        Inc(FRoundRobinIndex);
     609        if FRoundRobinIndex >= FMicroThreads.Count then
     610          FRoundRobinIndex := 0;
    556611      end;
    557612    end;
    558     if I < MicroThreads.Count then begin
    559       Result := TMicroThread(MicroThreads[RoundRobinIndex]);
     613    if I < FMicroThreads.Count then begin
     614      Result := TMicroThread(FMicroThreads[FRoundRobinIndex]);
    560615    end;
    561616  finally
    562     Lock.Release;
     617    FMicroThreadsLock.Release;
    563618  end;
    564619end;
    … …  
    567622begin
    568623  try
    569     Lock.Acquire;
    570     Result := MicroThreads.Count;
     624    FMicroThreadsLock.Acquire;
     625    Result := FMicroThreads.Count;
    571626  finally
    572     Lock.Release;
     627    FMicroThreadsLock.Release;
    573628  end;
    574629end;
    … …  
    576631function TMicroThreadScheduler.GetThreadPoolSize: Integer;
    577632begin
    578   Result := ThreadPool.Count;
     633  Result := FThreadPoolSize;
     634end;
     635
     636procedure TMicroThreadScheduler.SetActive(const AValue: Boolean);
     637begin
     638  if FActive = AValue then Exit;
     639  FActive := AValue;
     640  if AValue then Start
     641    else Stop;
    579642end;
    580643
    … …  
    584647  NewThread: TMicroThreadSchedulerPoolThread;
    585648begin
    586   if AValue > ThreadPool.Count then begin
    587     ThreadPool.Capacity := AValue;
    588     while ThreadPool.Count < AValue do begin
    589       NewThread := TMicroThreadSchedulerPoolThread.Create(True);
    590       NewThread.Manager.Scheduler := Self;
    591       ThreadPool.Add(NewThread);
    592     end;
    593   end else
    594   ThreadPool.Count := AValue;
     649  FThreadPoolSize := AValue;
     650  if FState = ssRunning then
     651    SetThreadPoolCount
    595652end;
    596653
Note: See TracChangeset for help on using the changeset viewer.