Changeset 159


Ignore:
Timestamp:
Jan 31, 2011, 2:16:21 PM (14 years ago)
Author:
george
Message:
  • Added: Running microthread list window.
  • Modified: Main thread is executed by application queued async call.
Location:
MicroThreading
Files:
2 added
1 deleted
6 edited

Legend:

Unmodified
Added
Removed

  • MicroThreading/Demo/Demo.lpi

    r158 r159  
    3939      </Item2>
    4040    </RequiredPackages>
    41     <Units Count="67">
     41    <Units Count="69">
    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"/>
    4849        <CursorPos X="34" Y="16"/>
    4950        <UsageCount Value="89"/>
     51        <Loaded Value="True"/>
    5052      </Unit0>
    5153      <Unit1>
    … …  
    5557        <ResourceBaseClass Value="Form"/>
    5658        <UnitName Value="UMainForm"/>
    57         <EditorIndex Value="5"/>
    58         <WindowIndex Value="0"/>
    59         <TopLine Value="351"/>
    60         <CursorPos X="54" Y="366"/>
     59        <EditorIndex Value="2"/>
     60        <WindowIndex Value="0"/>
     61        <TopLine Value="100"/>
     62        <CursorPos X="45" Y="122"/>
    6163        <UsageCount Value="89"/>
    6264        <Loaded Value="True"/>
    … …  
    6668        <Filename Value="../UMicroThreading.pas"/>
    6769        <UnitName Value="UMicroThreading"/>
    68         <IsVisibleTab Value="True"/>
    6970        <EditorIndex Value="0"/>
    7071        <WindowIndex Value="0"/>
    71         <TopLine Value="319"/>
    72         <CursorPos X="9" Y="330"/>
     72        <TopLine Value="317"/>
     73        <CursorPos X="26" Y="334"/>
    7374        <UsageCount Value="46"/>
    7475        <Loaded Value="True"/>
    … …  
    142143      <Unit11>
    143144        <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/inc/systemh.inc"/>
    144         <EditorIndex Value="1"/>
    145145        <WindowIndex Value="0"/>
    146146        <TopLine Value="469"/>
    147147        <CursorPos X="3" Y="484"/>
    148148        <UsageCount Value="12"/>
    149         <Loaded Value="True"/>
    150149      </Unit11>
    151150      <Unit12>
    … …  
    194193      <Unit18>
    195194        <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/objpas/classes/classesh.inc"/>
    196         <EditorIndex Value="3"/>
    197195        <WindowIndex Value="0"/>
    198196        <TopLine Value="1"/>
    199197        <CursorPos X="50" Y="9"/>
    200198        <UsageCount Value="12"/>
    201         <Loaded Value="True"/>
    202199      </Unit18>
    203200      <Unit19>
    … …  
    227224        <WindowIndex Value="0"/>
    228225        <TopLine Value="1"/>
    229         <CursorPos X="25" Y="9"/>
     226        <CursorPos X="63" Y="10"/>
    230227        <UsageCount Value="10"/>
    231228      </Unit22>
    … …  
    298295        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/classesh.inc"/>
    299296        <WindowIndex Value="0"/>
    300         <TopLine Value="302"/>
    301         <CursorPos X="19" Y="319"/>
     297        <TopLine Value="1638"/>
     298        <CursorPos X="28" Y="1645"/>
    302299        <UsageCount Value="20"/>
    303300      </Unit32>
    … …  
    410407        <Filename Value="../UPlatform.pas"/>
    411408        <UnitName Value="UPlatform"/>
    412         <EditorIndex Value="4"/>
     409        <EditorIndex Value="1"/>
    413410        <WindowIndex Value="0"/>
    414411        <TopLine Value="23"/>
    … …  
    510507        <TopLine Value="1"/>
    511508        <CursorPos X="17" Y="14"/>
    512         <UsageCount Value="9"/>
     509        <UsageCount Value="10"/>
    513510        <DefaultSyntaxHighlighter Value="None"/>
    514511      </Unit61>
    … …  
    517514        <UnitName Value="Forms"/>
    518515        <WindowIndex Value="0"/>
    519         <TopLine Value="57"/>
    520         <CursorPos X="3" Y="70"/>
    521         <UsageCount Value="9"/>
     516        <TopLine Value="1688"/>
     517        <CursorPos X="1" Y="1701"/>
     518        <UsageCount Value="10"/>
    522519      </Unit62>
    523520      <Unit63>
    … …  
    538535      <Unit65>
    539536        <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/inc/system.inc"/>
    540         <EditorIndex Value="2"/>
    541537        <WindowIndex Value="0"/>
    542538        <TopLine Value="671"/>
    543539        <CursorPos X="1" Y="673"/>
    544540        <UsageCount Value="11"/>
    545         <Loaded Value="True"/>
    546541      </Unit65>
    547542      <Unit66>
    548543        <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/inc/objpash.inc"/>
    549         <EditorIndex Value="6"/>
    550544        <WindowIndex Value="0"/>
    551545        <TopLine Value="160"/>
    552546        <CursorPos X="23" Y="175"/>
    553547        <UsageCount Value="11"/>
     548      </Unit66>
     549      <Unit67>
     550        <Filename Value="../UMicroThreadList.pas"/>
     551        <ComponentName Value="MicroThreadListForm"/>
     552        <ResourceBaseClass Value="Form"/>
     553        <UnitName Value="UMicroThreadList"/>
     554        <IsVisibleTab Value="True"/>
     555        <EditorIndex Value="3"/>
     556        <WindowIndex Value="0"/>
     557        <TopLine Value="1"/>
     558        <CursorPos X="29" Y="9"/>
     559        <UsageCount Value="10"/>
    554560        <Loaded Value="True"/>
    555       </Unit66>
     561        <LoadedDesigner Value="True"/>
     562      </Unit67>
     563      <Unit68>
     564        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/lcl/include/customform.inc"/>
     565        <WindowIndex Value="0"/>
     566        <TopLine Value="2100"/>
     567        <CursorPos X="1" Y="2113"/>
     568        <UsageCount Value="10"/>
     569      </Unit68>
    556570    </Units>
    557     <JumpHistory Count="30" HistoryIndex="29">
     571    <JumpHistory Count="21" HistoryIndex="20">
    558572      <Position1>
    559         <Filename Value="../UMicroThreading.pas"/>
    560         <Caret Line="615" Column="1" TopLine="599"/>
     573        <Filename Value="UMainForm.pas"/>
     574        <Caret Line="147" Column="10" TopLine="147"/>
    561575      </Position1>
    562576      <Position2>
    563         <Filename Value="../UMicroThreading.pas"/>
    564         <Caret Line="614" Column="1" TopLine="599"/>
     577        <Filename Value="UMainForm.pas"/>
     578        <Caret Line="10" Column="26" TopLine="1"/>
    565579      </Position2>
    566580      <Position3>
    567         <Filename Value="../UMicroThreading.pas"/>
    568         <Caret Line="615" Column="1" TopLine="599"/>
     581        <Filename Value="UMainForm.pas"/>
     582        <Caret Line="16" Column="48" TopLine="1"/>
    569583      </Position3>
    570584      <Position4>
    571585        <Filename Value="../UMicroThreading.pas"/>
    572         <Caret Line="614" Column="1" TopLine="599"/>
     586        <Caret Line="227" Column="20" TopLine="206"/>
    573587      </Position4>
    574588      <Position5>
    575589        <Filename Value="../UMicroThreading.pas"/>
    576         <Caret Line="615" Column="1" TopLine="599"/>
     590        <Caret Line="21" Column="33" TopLine="1"/>
    577591      </Position5>
    578592      <Position6>
    579         <Filename Value="../UMicroThreading.pas"/>
    580         <Caret Line="614" Column="1" TopLine="599"/>
     593        <Filename Value="UMainForm.pas"/>
     594        <Caret Line="90" Column="26" TopLine="85"/>
    581595      </Position6>
    582596      <Position7>
    583         <Filename Value="../UMicroThreading.pas"/>
    584         <Caret Line="615" Column="1" TopLine="599"/>
     597        <Filename Value="UMainForm.pas"/>
     598        <Caret Line="5" Column="15" TopLine="1"/>
    585599      </Position7>
    586600      <Position8>
    587         <Filename Value="../UMicroThreading.pas"/>
    588         <Caret Line="614" Column="1" TopLine="599"/>
     601        <Filename Value="UMainForm.pas"/>
     602        <Caret Line="150" Column="28" TopLine="147"/>
    589603      </Position8>
    590604      <Position9>
    591         <Filename Value="../UMicroThreading.pas"/>
    592         <Caret Line="615" Column="1" TopLine="599"/>
     605        <Filename Value="UMainForm.pas"/>
     606        <Caret Line="85" Column="15" TopLine="72"/>
    593607      </Position9>
    594608      <Position10>
    595         <Filename Value="../UMicroThreading.pas"/>
    596         <Caret Line="616" Column="1" TopLine="599"/>
     609        <Filename Value="UMainForm.pas"/>
     610        <Caret Line="151" Column="15" TopLine="138"/>
    597611      </Position10>
    598612      <Position11>
    599         <Filename Value="../UMicroThreading.pas"/>
    600         <Caret Line="618" Column="1" TopLine="599"/>
     613        <Filename Value="UMainForm.pas"/>
     614        <Caret Line="93" Column="30" TopLine="80"/>
    601615      </Position11>
    602616      <Position12>
    603         <Filename Value="../UMicroThreading.pas"/>
    604         <Caret Line="620" Column="1" TopLine="599"/>
     617        <Filename Value="UMainForm.pas"/>
     618        <Caret Line="123" Column="59" TopLine="110"/>
    605619      </Position12>
    606620      <Position13>
    607         <Filename Value="../UMicroThreading.pas"/>
    608         <Caret Line="325" Column="3" TopLine="321"/>
     621        <Filename Value="UMainForm.pas"/>
     622        <Caret Line="122" Column="1" TopLine="110"/>
    609623      </Position13>
    610624      <Position14>
    611625        <Filename Value="../UMicroThreading.pas"/>
    612         <Caret Line="321" Column="69" TopLine="319"/>
     626        <Caret Line="217" Column="1" TopLine="197"/>
    613627      </Position14>
    614628      <Position15>
    615629        <Filename Value="../UMicroThreading.pas"/>
    616         <Caret Line="326" Column="1" TopLine="319"/>
     630        <Caret Line="250" Column="20" TopLine="230"/>
    617631      </Position15>
    618632      <Position16>
    619         <Filename Value="../UMicroThreading.pas"/>
    620         <Caret Line="327" Column="1" TopLine="319"/>
     633        <Filename Value="UMainForm.pas"/>
     634        <Caret Line="150" Column="16" TopLine="145"/>
    621635      </Position16>
    622636      <Position17>
    623         <Filename Value="../UMicroThreading.pas"/>
    624         <Caret Line="411" Column="22" TopLine="403"/>
     637        <Filename Value="UMainForm.pas"/>
     638        <Caret Line="93" Column="25" TopLine="80"/>
    625639      </Position17>
    626640      <Position18>
    627641        <Filename Value="../UMicroThreading.pas"/>
    628         <Caret Line="863" Column="10" TopLine="841"/>
     642        <Caret Line="338" Column="3" TopLine="336"/>
    629643      </Position18>
    630644      <Position19>
    631         <Filename Value="../UMicroThreading.pas"/>
    632         <Caret Line="861" Column="1" TopLine="841"/>
     645        <Filename Value="UMainForm.pas"/>
     646        <Caret Line="5" Column="74" TopLine="3"/>
    633647      </Position19>
    634648      <Position20>
    635649        <Filename Value="../UMicroThreading.pas"/>
    636         <Caret Line="862" Column="1" TopLine="841"/>
     650        <Caret Line="208" Column="22" TopLine="204"/>
    637651      </Position20>
    638652      <Position21>
    639653        <Filename Value="../UMicroThreading.pas"/>
    640         <Caret Line="863" Column="1" TopLine="841"/>
     654        <Caret Line="336" Column="36" TopLine="314"/>
    641655      </Position21>
    642       <Position22>
    643         <Filename Value="../UMicroThreading.pas"/>
    644         <Caret Line="861" Column="1" TopLine="841"/>
    645       </Position22>
    646       <Position23>
    647         <Filename Value="../UMicroThreading.pas"/>
    648         <Caret Line="843" Column="33" TopLine="841"/>
    649       </Position23>
    650       <Position24>
    651         <Filename Value="../UMicroThreading.pas"/>
    652         <Caret Line="325" Column="5" TopLine="319"/>
    653       </Position24>
    654       <Position25>
    655         <Filename Value="../UMicroThreading.pas"/>
    656         <Caret Line="326" Column="1" TopLine="319"/>
    657       </Position25>
    658       <Position26>
    659         <Filename Value="../UMicroThreading.pas"/>
    660         <Caret Line="327" Column="1" TopLine="319"/>
    661       </Position26>
    662       <Position27>
    663         <Filename Value="../UMicroThreading.pas"/>
    664         <Caret Line="328" Column="1" TopLine="319"/>
    665       </Position27>
    666       <Position28>
    667         <Filename Value="../UMicroThreading.pas"/>
    668         <Caret Line="329" Column="1" TopLine="319"/>
    669       </Position28>
    670       <Position29>
    671         <Filename Value="../UMicroThreading.pas"/>
    672         <Caret Line="328" Column="1" TopLine="319"/>
    673       </Position29>
    674       <Position30>
    675         <Filename Value="../UMicroThreading.pas"/>
    676         <Caret Line="329" Column="1" TopLine="319"/>
    677       </Position30>
    678656    </JumpHistory>
    679657  </ProjectOptions>
    … …  
    714692  </CompilerOptions>
    715693  <Debugging>
    716     <BreakPoints Count="2">
     694    <BreakPoints Count="1">
    717695      <Item1>
    718696        <Source Value="../UMicroThreading.pas"/>
    719         <Line Value="869"/>
     697        <Line Value="250"/>
    720698      </Item1>
    721       <Item2>
    722         <Source Value="../UMicroThreading.pas"/>
    723         <Line Value="325"/>
    724       </Item2>
    725699    </BreakPoints>
    726700    <Watches Count="2">

  • MicroThreading/Demo/UMainForm.lfm

    r158 r159  
    11object MainForm: TMainForm
    2   Left = 224
     2  Left = 237
    33  Height = 533
    4   Top = 98
     4  Top = 102
    55  Width = 816
    66  Caption = 'MicroThreading demo'
    … …  
    1616    Top = 8
    1717    Width = 802
    18     ActivePage = TabSheet1
     18    ActivePage = TabSheet2
    1919    Anchors = [akTop, akLeft, akRight, akBottom]
    20     TabIndex = 1
     20    TabIndex = 0
    2121    TabOrder = 0
    2222    object TabSheet2: TTabSheet
    2323      Caption = 'Scheduler state'
    24       ClientHeight = 492
    25       ClientWidth = 798
    26       object ListView1: TListView
    27         Left = 222
    28         Height = 459
    29         Top = 24
    30         Width = 571
    31         Anchors = [akTop, akLeft, akRight, akBottom]
    32         Columns = <       
    33           item
    34             Caption = 'Id'
    35             Width = 40
    36           end       
    37           item
    38             Caption = 'Usage'
    39           end       
    40           item
    41             Caption = 'Priority'
    42           end       
    43           item
    44             Caption = 'State'
    45             Width = 60
    46           end       
    47           item
    48             Caption = 'Block state'
    49           end       
    50           item
    51             Caption = 'Execution time'
    52             Width = 70
    53           end       
    54           item
    55             Caption = 'Execution count'
    56           end       
    57           item
    58             Caption = 'Completion'
    59           end       
    60           item
    61             Caption = 'Used stack'
    62             Width = 178
    63           end       
    64           item
    65             Caption = 'Name'
    66           end>
    67         OwnerData = True
    68         ReadOnly = True
    69         RowSelect = True
    70         TabOrder = 0
    71         ViewStyle = vsReport
    72         OnData = ListView1Data
    73       end
    74       object Label1: TLabel
    75         Left = 222
    76         Height = 14
    77         Top = 7
    78         Width = 76
    79         Caption = 'Microthreads:'
    80         ParentColor = False
    81       end
     24      ClientHeight = 493
     25      ClientWidth = 794
    8226      object GroupBox1: TGroupBox
    8327        Left = 6
    … …  
    8630        Width = 205
    8731        Caption = 'State'
    88         ClientHeight = 66
     32        ClientHeight = 63
    8933        ClientWidth = 201
    90         TabOrder = 1
     34        TabOrder = 0
    9135        object Label5: TLabel
    9236          Left = 9
    9337          Height = 14
    9438          Top = 4
    95           Width = 135
     39          Width = 117
    9640          Caption = 'Logical processor count:'
    9741          ParentColor = False
    … …  
    10953          Height = 14
    11054          Top = 20
    111           Width = 78
     55          Width = 69
    11256          Caption = 'Thread count:'
    11357          ParentColor = False
    … …  
    11761          Height = 14
    11862          Top = 36
    119           Width = 107
     63          Width = 95
    12064          Caption = 'Micro thread count:'
    12165          ParentColor = False
    … …  
    14185          Height = 14
    14286          Top = 52
    143           Width = 83
     87          Width = 73
    14488          Caption = 'Main thread id:'
    14589          ParentColor = False
    … …  
    160104        Width = 206
    161105        Caption = 'Control'
    162         ClientHeight = 111
     106        ClientHeight = 108
    163107        ClientWidth = 202
    164         TabOrder = 2
     108        TabOrder = 1
    165109        object ButtonSchedulerStartStop: TButton
    166110          Left = 8
    … …  
    176120          Height = 14
    177121          Top = 46
    178           Width = 78
     122          Width = 69
    179123          Caption = 'Thread count:'
    180124          ParentColor = False
    … …  
    190134        object CheckBoxUseMainThread: TCheckBox
    191135          Left = 10
    192           Height = 20
     136          Height = 17
    193137          Top = 64
    194           Width = 112
     138          Width = 98
    195139          Caption = 'Use main thread'
    196140          OnChange = CheckBoxUseMainThreadChange
    … …  
    200144      object ListView2: TListView
    201145        Left = 6
    202         Height = 236
     146        Height = 237
    203147        Top = 247
    204148        Width = 206
    … …  
    213157          end>
    214158        OwnerData = True
    215         TabOrder = 3
     159        TabOrder = 2
    216160        ViewStyle = vsReport
    217161        OnData = ListView2Data
    … …  
    221165        Height = 14
    222166        Top = 233
    223         Width = 50
     167        Width = 44
    224168        Caption = 'Threads:'
    225169        ParentColor = False
     170      end
     171      object Button4: TButton
     172        Left = 226
     173        Height = 25
     174        Top = 17
     175        Width = 123
     176        Caption = 'Show manager'
     177        OnClick = Button4Click
     178        TabOrder = 3
    226179      end
    227180    end
    228181    object TabSheet1: TTabSheet
    229182      Caption = 'Job control'
    230       ClientHeight = 492
    231       ClientWidth = 798
     183      ClientHeight = 493
     184      ClientWidth = 794
    232185      object ButtonAddWorkers: TButton
    233186        Left = 10
    … …  
    252205        Height = 14
    253206        Top = 14
    254         Width = 37
     207        Width = 34
    255208        Caption = 'Count:'
    256209        ParentColor = False
    … …  
    269222      object Memo1: TMemo
    270223        Left = 316
    271         Height = 243
     224        Height = 244
    272225        Top = 14
    273226        Width = 294
    … …  
    289242        Height = 14
    290243        Top = 38
    291         Width = 57
     244        Width = 52
    292245        Caption = 'Iterations:'
    293246        ParentColor = False
    … …  
    309262        Width = 292
    310263        Caption = 'Do inside jobs'
    311         ClientHeight = 122
     264        ClientHeight = 119
    312265        ClientWidth = 288
    313266        TabOrder = 6
    314267        object CheckBox1: TCheckBox
    315268          Left = 4
    316           Height = 20
     269          Height = 17
    317270          Top = 9
    318           Width = 76
     271          Width = 66
    319272          Caption = 'Use sleep'
    320273          OnChange = CheckBox1Change
    … …  
    334287          Height = 14
    335288          Top = 15
    336           Width = 17
     289          Width = 14
    337290          Caption = 'ms'
    338291          ParentColor = False
    … …  
    340293        object CheckBox2: TCheckBox
    341294          Left = 5
    342           Height = 20
     295          Height = 17
    343296          Top = 32
    344           Width = 126
     297          Width = 112
    345298          Caption = 'Write test to memo'
    346299          OnChange = CheckBox2Change
    … …  
    349302        object CheckBox3: TCheckBox
    350303          Left = 5
    351           Height = 20
     304          Height = 17
    352305          Top = 56
    353           Width = 98
     306          Width = 90
    354307          Caption = 'Wait for event'
    355308          OnChange = CheckBox3Change
    … …  
    379332          Height = 14
    380333          Top = 56
    381           Width = 17
     334          Width = 14
    382335          Caption = 'ms'
    383336          ParentColor = False

  • MicroThreading/Demo/UMainForm.pas

    r158 r159  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ComCtrls, ExtCtrls, Spin, UMicroThreading, DateUtils, UPlatform;
     9  ComCtrls, ExtCtrls, Spin, UMicroThreading, DateUtils, UPlatform,
     10  UMicroThreadList;
    1011
    1112type
    12 
    1313  TMainForm = class;
    1414
    … …  
    2828    Button2: TButton;
    2929    Button3: TButton;
     30    Button4: TButton;
    3031    ButtonAddWorkers: TButton;
    3132    ButtonClearMicroThreads: TButton;
    … …  
    4041    GroupBox2: TGroupBox;
    4142    GroupBox3: TGroupBox;
    42     Label1: TLabel;
    4343    Label10: TLabel;
    4444    Label11: TLabel;
    … …  
    5757    Label8: TLabel;
    5858    Label9: TLabel;
    59     ListView1: TListView;
    6059    ListView2: TListView;
    6160    Memo1: TMemo;
    … …  
    7271    procedure Button1Click(Sender: TObject);
    7372    procedure Button3Click(Sender: TObject);
     73    procedure Button4Click(Sender: TObject);
    7474    procedure ButtonSchedulerStartStopClick(Sender: TObject);
    7575    procedure Button2Click(Sender: TObject);
    … …  
    8585    procedure FormDestroy(Sender: TObject);
    8686    procedure FormShow(Sender: TObject);
    87     procedure ListView1Data(Sender: TObject; Item: TListItem);
    8887    procedure ListView2Data(Sender: TObject; Item: TListItem);
    8988    procedure SpinEdit2Change(Sender: TObject);
    … …  
    9291    procedure TimerRedrawTimer(Sender: TObject);
    9392  private
     93    MicroThreadList: TMicroThreadList;
    9494    procedure WorkerSubRoutine;
    9595  public
    … …  
    117117begin
    118118  DoubleBuffered := True;
    119   ListView1.DoubleBuffered := True;
     119//  ListView1.DoubleBuffered := True;
    120120  Label6.Caption := IntToStr(GetLogicalProcessorCount);
    121121  Event := TMicroThreadEvent.Create;
     122  MicroThreadList := TMicroThreadList.Create(Self);
    122123end;
    123124
    … …  
    144145begin
    145146  Event.SetEvent;
     147end;
     148
     149procedure TMainForm.Button4Click(Sender: TObject);
     150begin
     151  MicroThreadList.Form.Show;
    146152end;
    147153
    … …  
    268274procedure TMainForm.FormDestroy(Sender: TObject);
    269275begin
     276  MicroThreadList.Free;
    270277  MainScheduler.Active := False;
    271278  Event.Free;
    … …  
    279286  ButtonSchedulerStartStop.Click;
    280287  Label16.Caption := IntToStr(MainThreadID);
    281 end;
    282 
    283 procedure TMainForm.ListView1Data(Sender: TObject; Item: TListItem);
    284 begin
    285   try
    286     MainScheduler.MicroThreadsLock.Acquire;
    287     if Item.Index < MainScheduler.MicroThreads.Count then
    288     with TMicroThread(MainScheduler.MicroThreads[Item.Index]) do begin
    289       Item.Caption := IntToStr(Id);
    290       Item.SubItems.Add('');
    291       Item.SubItems.Add(IntToStr(Priority));
    292       Item.SubItems.Add(MicroThreadStateText[State]);
    293       Item.SubItems.Add(MicroThreadBlockStateText[BlockState]);
    294       Item.SubItems.Add(FloatToStr(ExecutionTime));
    295       Item.SubItems.Add(IntToStr(ExecutionCount));
    296       Item.SubItems.Add(IntToStr(Trunc(Completion * 100)) + '%');
    297       Item.SubItems.Add(IntToStr(StackUsed));
    298       Item.SubItems.Add(Name);
    299     end;
    300   finally
    301     MainScheduler.MicroThreadsLock.Release;
    302   end;
    303288end;
    304289
    … …  
    334319procedure TMainForm.TimerRedrawTimer(Sender: TObject);
    335320begin
    336   if ListView1.Items.Count <> MainScheduler.MicroThreadCount then
    337     ListView1.Items.Count := MainScheduler.MicroThreadCount;
    338   ListView1.Items[-1];
    339   ListView1.Refresh;
    340 
    341321  if ListView2.Items.Count <> MainScheduler.ThreadPoolCount then
    342322    ListView2.Items.Count := MainScheduler.ThreadPoolCount;

  • MicroThreading/MicroThreading.lpk

    r153 r159  
    2020      <Item1>
    2121        <Filename Value="UMicroThreading.pas"/>
     22        <HasRegisterProc Value="True"/>
    2223        <UnitName Value="UMicroThreading"/>
    2324      </Item1>
    2425      <Item2>
    25         <Filename Value="Other/Coroutine.pas"/>
    26         <UnitName Value="Coroutine"/>
     26        <Filename Value="UPlatform.pas"/>
     27        <UnitName Value="UPlatform"/>
    2728      </Item2>
    2829      <Item3>
    29         <Filename Value="UPlatform.pas"/>
    30         <UnitName Value="UPlatform"/>
     30        <Filename Value="ReadMe.txt"/>
     31        <Type Value="Binary"/>
    3132      </Item3>
    3233      <Item4>
    33         <Filename Value="ReadMe.txt"/>
    34         <Type Value="Binary"/>
     34        <Filename Value="UMicroThreadList.pas"/>
     35        <UnitName Value="UMicroThreadList"/>
    3536      </Item4>
    3637    </Files>

  • MicroThreading/MicroThreading.pas

    r149 r159  
    88
    99uses
    10   UMicroThreading, Coroutine, UPlatform, LazarusPackageIntf;
     10  UMicroThreading, UPlatform, UMicroThreadList, LazarusPackageIntf;
    1111
    1212implementation
    … …  
    1414procedure Register;
    1515begin
     16  RegisterUnit('UMicroThreading', @UMicroThreading.Register);
    1617end;
    1718

  • MicroThreading/UMicroThreading.pas

    r158 r159  
    1818  cthreads,
    1919  {$ENDIF}{$ENDIF}
    20   Classes, ExtCtrls, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms, UPlatform;
     20  Classes, ExtCtrls, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms,
     21  UPlatform, UMicroThreadList;
    2122
    2223const
    23   DefaultStackSize = $4000;
     24  DefaultStackSize = $40000;
    2425
    2526type
    … …  
    191192    procedure UpdateThreadPoolSize;
    192193    procedure MainThreadStart(Sender: TObject);
     194    procedure MainThreadTick(Data: PtrInt);
    193195  public
    194196    function Add(MicroThread: TMicroThread): Integer;
    195197    function AddMethod(Method: TMicroThreadMethod): Integer;
    196     procedure Remove(MicroThread: TMicroThread);
     198    function FindCurrentThread: TThread;
     199    procedure Remove(MicroThread: TMicroThread; Free: Boolean = True);
    197200    constructor Create;
    198201    destructor Destroy; override;
    … …  
    210213  end;
    211214
     215  TMicroThreadList = class(TComponent)
     216  private
     217  public
     218    Form: TMicroThreadListForm;
     219    constructor Create(AOwner: TComponent);
     220  end;
     221
     222  TMicroThreadExceptionEvent = procedure(Sender: TObject; E: Exception) of object;
     223
    212224var
    213225  MainScheduler: TMicroThreadScheduler;
     226  ExceptionHandler: TMicroThreadExceptionEvent;
    214227
    215228const
    … …  
    223236function GetCurrentMicroThread: TMicroThread;
    224237procedure MTSleep(Duration: TDateTime);
     238procedure MTSynchronize(Method: TThreadMethod);
    225239function MTWaitForEvent(Event: TMicroThreadEvent; Duration: TDateTime): TWaitResult;
    226240procedure Log(Text: string);
     241procedure Register;
    227242
    228243const
    … …  
    235250//  StaticManager: TMicroThreadManager;
    236251//  StaticMicroThread: TMicroThread;
     252
     253procedure Register;
     254begin
     255  RegisterComponents('MicroThreading', [TMicroThreadList]);
     256end;
    237257
    238258function GetMicroThreadId: Integer;
    … …  
    267287  with MainScheduler do
    268288  try
    269     FThreadPoolLock.Acquire;
     289    FMicroThreadsLock.Acquire;
    270290    if MainThreadID = ThreadID then Result := MainThreadManager.CurrentMicroThread
    271     else begin
    272       I := 0;
    273       while (I < FThreadPool.Count) and (TMicroThreadThread(FThreadPool[I]).ThreadID <> ThreadID) do Inc(I);
    274       if I < FThreadPool.Count then Result := TMicroThreadThread(FThreadPool[I]).Manager.CurrentMicroThread
    275         else Result := nil;
    276     end;
    277   finally
    278     FThreadPoolLock.Release;
     291      else Result := TMicroThreadThread(MainScheduler.FindCurrentThread).Manager.CurrentMicroThread;
     292  finally
     293    FMicroThreadsLock.Release;
    279294  end;
    280295end;
    … …  
    289304end;
    290305
     306procedure MTSynchronize(Method: TThreadMethod);
     307var
     308  Thread: TThread;
     309begin
     310  if GetCurrentThreadId <> MainThreadID then begin
     311    Thread := MainScheduler.FindCurrentThread;
     312    if Assigned(Thread) then TThread.Synchronize(Thread, Method)
     313      else raise Exception.Create('Can''t determine thread for id ' + IntToStr(GetCurrentThreadId));
     314  end else Method;
     315end;
     316
    291317function MTWaitForEvent(Event: TMicroThreadEvent; Duration: TDateTime): TWaitResult;
    292318var
    … …  
    294320begin
    295321  MT := GetCurrentMicroThread;
    296   if Assigned(MT) then Result := MT.WaitForEvent(Event, Duration);
     322  if Assigned(MT) then Result := MT.WaitForEvent(Event, Duration)
     323    else raise Exception.Create('Not in thread');
    297324//    else Result := Event.WaitFor(Trunc(Duration / OneMillisecond));
    298325end;
    … …  
    316343  end;
    317344end;
     345
     346{ TMicroThreadList }
     347
     348constructor TMicroThreadList.Create(AOwner: TComponent);
     349begin
     350  inherited;
     351  Form := TMicroThreadListForm.Create(Self);
     352end;
     353
     354
    318355
    319356{ TMicroThreadMethod }
    … …  
    360397destructor TMicroThreadEvent.Destroy;
    361398begin
    362   MainScheduler.FEvents.Delete(MainScheduler.FEvents.IndexOf(Self));
     399  try
     400    MainScheduler.FEvents.OwnsObjects := False;
     401    MainScheduler.FEvents.Delete(MainScheduler.FEvents.IndexOf(Self));
     402  finally
     403    MainScheduler.FEvents.OwnsObjects := True;
     404  end;
    363405  FMicroThreadsLock.Free;
    364406  FMicroThreads.Free;
    … …  
    441483          // but virtual methods can be called only statically
    442484          // Then static method CallExecute is calling virtual method Execute
    443           call TMicroThread.CallExecute
     485            call TMicroThread.CallExecute
    444486
    445487          // Restore manager stack
    … …  
    522564    until Terminated;
    523565  except
    524     on E: Exception do ;
    525       //ExceptionHandler(E);
     566    on E: Exception do
     567      if Assigned(ExceptionHandler) then ExceptionHandler(Self, E);
    526568  end;
    527569end;
    … …  
    549591end;
    550592
    551 
    552593{ TMicroThread }
    553594
    554595procedure TMicroThread.CallExecute;
    555596begin
    556   Execute;
     597  try
     598    Execute;
     599  except
     600    on E: Exception do
     601      ExceptionHandler(Self, E);
     602  end;
    557603  asm
    558604    mov ecx, Self
    … …  
    631677  end;
    632678  Yield;
     679  if FBlockTime < NowPrecise then
     680    Result := wrTimeout else Result := wrSignaled;
     681
    633682  try
    634683    Event.FMicroThreadsLock.Acquire;
    … …  
    669718destructor TMicroThread.Destroy;
    670719begin
     720  MainScheduler.Remove(Self, False);
    671721  //Terminate;
    672722  //WaitFor;
    … …  
    718768end;
    719769
    720 procedure TMicroThreadScheduler.Remove(MicroThread: TMicroThread);
     770function TMicroThreadScheduler.FindCurrentThread: TThread;
     771var
     772  I: Integer;
     773begin
     774  try
     775    FThreadPoolLock.Acquire;
     776    I := 0;
     777    while (I < FThreadPool.Count) and (TMicroThreadThread(FThreadPool[I]).ThreadID <> ThreadID) do Inc(I);
     778    if I < FThreadPool.Count then Result := TMicroThreadThread(FThreadPool[I])
     779      else Result := nil;
     780  finally
     781    FThreadPoolLock.Release;
     782  end;
     783end;
     784
     785procedure TMicroThreadScheduler.Remove(MicroThread: TMicroThread;
     786  Free: Boolean = True);
    721787begin
    722788  try
    723789    FMicroThreadsLock.Acquire;
     790    if not Free then FMicroThreads.OwnsObjects := False;
    724791    FMicroThreads.Remove(MicroThread);
     792    FMicroThreads.OwnsObjects := True;
    725793  finally
    726794    FMicroThreadsLock.Release;
    … …  
    824892
    825893procedure TMicroThreadScheduler.MainThreadStart(Sender: TObject);
    826 var
    827   Executed: Integer;
    828894begin
    829895  FMainThreadStarter.Enabled := False;
    830896  FMainThreadTerminated := False;
    831   repeat
    832     Executed := FMainThreadManager.Execute(1);
    833     Application.ProcessMessages;
    834     if Executed = 0 then Sleep(1);
    835   until (FState <> ssRunning) or (not FUseMainThread);
    836   FMainThreadTerminated := True;
     897  Application.QueueAsyncCall(MainThreadTick, 0);
     898end;
     899
     900procedure TMicroThreadScheduler.MainThreadTick(Data: PtrInt);
     901var
     902  Executed: Integer;
     903begin
     904  Executed := FMainThreadManager.Execute(1);
     905  if Executed = 0 then Sleep(1);
     906  // If not terminated then queue next tick else terminate
     907  if (FState = ssRunning) and FUseMainThread then
     908    Application.QueueAsyncCall(MainThreadTick, 0)
     909    else FMainThreadTerminated := True;
    837910end;
    838911
Note: See TracChangeset for help on using the changeset viewer.