Changeset 158 for MicroThreading/Demo


Ignore:
Timestamp:
Jan 28, 2011, 9:10:16 PM (14 years ago)
Author:
george
Message:
  • Fixed: WaitForEvent functionality. Now TEvent.WaitFor will chane microthread to blocked state with defined timeout. TEvent.SetSignal method will unblock all waiting microthreads.
Location:
MicroThreading/Demo
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • MicroThreading/Demo/Demo.lpi

    r157 r158  
    3939      </Item2>
    4040    </RequiredPackages>
    41     <Units Count="65">
     41    <Units Count="67">
    4242      <Unit0>
    4343        <Filename Value="Demo.lpr"/>
    … …  
    4747        <TopLine Value="1"/>
    4848        <CursorPos X="34" Y="16"/>
    49         <UsageCount Value="86"/>
     49        <UsageCount Value="89"/>
    5050      </Unit0>
    5151      <Unit1>
    … …  
    5555        <ResourceBaseClass Value="Form"/>
    5656        <UnitName Value="UMainForm"/>
    57         <EditorIndex Value="4"/>
    58         <WindowIndex Value="0"/>
    59         <TopLine Value="247"/>
    60         <CursorPos X="1" Y="261"/>
    61         <UsageCount Value="86"/>
     57        <EditorIndex Value="5"/>
     58        <WindowIndex Value="0"/>
     59        <TopLine Value="351"/>
     60        <CursorPos X="54" Y="366"/>
     61        <UsageCount Value="89"/>
    6262        <Loaded Value="True"/>
    6363        <LoadedDesigner Value="True"/>
    … …  
    6969        <EditorIndex Value="0"/>
    7070        <WindowIndex Value="0"/>
    71         <TopLine Value="175"/>
    72         <CursorPos X="1" Y="190"/>
    73         <UsageCount Value="45"/>
     71        <TopLine Value="319"/>
     72        <CursorPos X="9" Y="330"/>
     73        <UsageCount Value="46"/>
    7474        <Loaded Value="True"/>
    7575      </Unit2>
    … …  
    144144        <EditorIndex Value="1"/>
    145145        <WindowIndex Value="0"/>
    146         <TopLine Value="896"/>
    147         <CursorPos X="10" Y="911"/>
    148         <UsageCount Value="10"/>
     146        <TopLine Value="469"/>
     147        <CursorPos X="3" Y="484"/>
     148        <UsageCount Value="12"/>
    149149        <Loaded Value="True"/>
    150150      </Unit11>
    … …  
    194194      <Unit18>
    195195        <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/objpas/classes/classesh.inc"/>
    196         <EditorIndex Value="2"/>
     196        <EditorIndex Value="3"/>
    197197        <WindowIndex Value="0"/>
    198198        <TopLine Value="1"/>
    199199        <CursorPos X="50" Y="9"/>
    200         <UsageCount Value="10"/>
     200        <UsageCount Value="12"/>
    201201        <Loaded Value="True"/>
    202202      </Unit18>
    … …  
    410410        <Filename Value="../UPlatform.pas"/>
    411411        <UnitName Value="UPlatform"/>
    412         <EditorIndex Value="3"/>
     412        <EditorIndex Value="4"/>
    413413        <WindowIndex Value="0"/>
    414414        <TopLine Value="23"/>
    415415        <CursorPos X="31" Y="38"/>
    416         <UsageCount Value="25"/>
     416        <UsageCount Value="26"/>
    417417        <Loaded Value="True"/>
    418418      </Unit48>
    … …  
    536536        <UsageCount Value="15"/>
    537537      </Unit64>
     538      <Unit65>
     539        <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/inc/system.inc"/>
     540        <EditorIndex Value="2"/>
     541        <WindowIndex Value="0"/>
     542        <TopLine Value="671"/>
     543        <CursorPos X="1" Y="673"/>
     544        <UsageCount Value="11"/>
     545        <Loaded Value="True"/>
     546      </Unit65>
     547      <Unit66>
     548        <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/inc/objpash.inc"/>
     549        <EditorIndex Value="6"/>
     550        <WindowIndex Value="0"/>
     551        <TopLine Value="160"/>
     552        <CursorPos X="23" Y="175"/>
     553        <UsageCount Value="11"/>
     554        <Loaded Value="True"/>
     555      </Unit66>
    538556    </Units>
    539557    <JumpHistory Count="30" HistoryIndex="29">
    540558      <Position1>
    541559        <Filename Value="../UMicroThreading.pas"/>
    542         <Caret Line="531" Column="1" TopLine="515"/>
     560        <Caret Line="615" Column="1" TopLine="599"/>
    543561      </Position1>
    544562      <Position2>
    545563        <Filename Value="../UMicroThreading.pas"/>
    546         <Caret Line="532" Column="1" TopLine="515"/>
     564        <Caret Line="614" Column="1" TopLine="599"/>
    547565      </Position2>
    548566      <Position3>
    549567        <Filename Value="../UMicroThreading.pas"/>
    550         <Caret Line="954" Column="1" TopLine="939"/>
     568        <Caret Line="615" Column="1" TopLine="599"/>
    551569      </Position3>
    552570      <Position4>
    553571        <Filename Value="../UMicroThreading.pas"/>
    554         <Caret Line="822" Column="1" TopLine="807"/>
     572        <Caret Line="614" Column="1" TopLine="599"/>
    555573      </Position4>
    556574      <Position5>
    557575        <Filename Value="../UMicroThreading.pas"/>
    558         <Caret Line="824" Column="1" TopLine="807"/>
     576        <Caret Line="615" Column="1" TopLine="599"/>
    559577      </Position5>
    560578      <Position6>
    561579        <Filename Value="../UMicroThreading.pas"/>
    562         <Caret Line="955" Column="1" TopLine="940"/>
     580        <Caret Line="614" Column="1" TopLine="599"/>
    563581      </Position6>
    564582      <Position7>
    565         <Filename Value="UMainForm.pas"/>
    566         <Caret Line="262" Column="1" TopLine="247"/>
     583        <Filename Value="../UMicroThreading.pas"/>
     584        <Caret Line="615" Column="1" TopLine="599"/>
    567585      </Position7>
    568586      <Position8>
    569         <Filename Value="UMainForm.pas"/>
    570         <Caret Line="261" Column="1" TopLine="247"/>
     587        <Filename Value="../UMicroThreading.pas"/>
     588        <Caret Line="614" Column="1" TopLine="599"/>
    571589      </Position8>
    572590      <Position9>
    573591        <Filename Value="../UMicroThreading.pas"/>
    574         <Caret Line="816" Column="1" TopLine="801"/>
     592        <Caret Line="615" Column="1" TopLine="599"/>
    575593      </Position9>
    576594      <Position10>
    577595        <Filename Value="../UMicroThreading.pas"/>
    578         <Caret Line="777" Column="1" TopLine="756"/>
     596        <Caret Line="616" Column="1" TopLine="599"/>
    579597      </Position10>
    580598      <Position11>
    581599        <Filename Value="../UMicroThreading.pas"/>
    582         <Caret Line="760" Column="1" TopLine="754"/>
     600        <Caret Line="618" Column="1" TopLine="599"/>
    583601      </Position11>
    584602      <Position12>
    585603        <Filename Value="../UMicroThreading.pas"/>
    586         <Caret Line="762" Column="1" TopLine="754"/>
     604        <Caret Line="620" Column="1" TopLine="599"/>
    587605      </Position12>
    588606      <Position13>
    589607        <Filename Value="../UMicroThreading.pas"/>
    590         <Caret Line="763" Column="1" TopLine="754"/>
     608        <Caret Line="325" Column="3" TopLine="321"/>
    591609      </Position13>
    592610      <Position14>
    593611        <Filename Value="../UMicroThreading.pas"/>
    594         <Caret Line="764" Column="1" TopLine="754"/>
     612        <Caret Line="321" Column="69" TopLine="319"/>
    595613      </Position14>
    596614      <Position15>
    597615        <Filename Value="../UMicroThreading.pas"/>
    598         <Caret Line="768" Column="2" TopLine="754"/>
     616        <Caret Line="326" Column="1" TopLine="319"/>
    599617      </Position15>
    600618      <Position16>
    601619        <Filename Value="../UMicroThreading.pas"/>
    602         <Caret Line="767" Column="1" TopLine="754"/>
     620        <Caret Line="327" Column="1" TopLine="319"/>
    603621      </Position16>
    604622      <Position17>
    605623        <Filename Value="../UMicroThreading.pas"/>
    606         <Caret Line="768" Column="1" TopLine="754"/>
     624        <Caret Line="411" Column="22" TopLine="403"/>
    607625      </Position17>
    608626      <Position18>
    609627        <Filename Value="../UMicroThreading.pas"/>
    610         <Caret Line="769" Column="1" TopLine="754"/>
     628        <Caret Line="863" Column="10" TopLine="841"/>
    611629      </Position18>
    612630      <Position19>
    613631        <Filename Value="../UMicroThreading.pas"/>
    614         <Caret Line="768" Column="1" TopLine="754"/>
     632        <Caret Line="861" Column="1" TopLine="841"/>
    615633      </Position19>
    616634      <Position20>
    617635        <Filename Value="../UMicroThreading.pas"/>
    618         <Caret Line="770" Column="22" TopLine="754"/>
     636        <Caret Line="862" Column="1" TopLine="841"/>
    619637      </Position20>
    620638      <Position21>
    621639        <Filename Value="../UMicroThreading.pas"/>
    622         <Caret Line="760" Column="1" TopLine="754"/>
     640        <Caret Line="863" Column="1" TopLine="841"/>
    623641      </Position21>
    624642      <Position22>
    625643        <Filename Value="../UMicroThreading.pas"/>
    626         <Caret Line="762" Column="1" TopLine="754"/>
     644        <Caret Line="861" Column="1" TopLine="841"/>
    627645      </Position22>
    628646      <Position23>
    629647        <Filename Value="../UMicroThreading.pas"/>
    630         <Caret Line="767" Column="1" TopLine="754"/>
     648        <Caret Line="843" Column="33" TopLine="841"/>
    631649      </Position23>
    632650      <Position24>
    633651        <Filename Value="../UMicroThreading.pas"/>
    634         <Caret Line="768" Column="1" TopLine="754"/>
     652        <Caret Line="325" Column="5" TopLine="319"/>
    635653      </Position24>
    636654      <Position25>
    637655        <Filename Value="../UMicroThreading.pas"/>
    638         <Caret Line="770" Column="1" TopLine="754"/>
     656        <Caret Line="326" Column="1" TopLine="319"/>
    639657      </Position25>
    640658      <Position26>
    641659        <Filename Value="../UMicroThreading.pas"/>
    642         <Caret Line="772" Column="1" TopLine="754"/>
     660        <Caret Line="327" Column="1" TopLine="319"/>
    643661      </Position26>
    644662      <Position27>
    645663        <Filename Value="../UMicroThreading.pas"/>
    646         <Caret Line="776" Column="1" TopLine="754"/>
     664        <Caret Line="328" Column="1" TopLine="319"/>
    647665      </Position27>
    648666      <Position28>
    649667        <Filename Value="../UMicroThreading.pas"/>
    650         <Caret Line="777" Column="1" TopLine="754"/>
     668        <Caret Line="329" Column="1" TopLine="319"/>
    651669      </Position28>
    652670      <Position29>
    653671        <Filename Value="../UMicroThreading.pas"/>
    654         <Caret Line="778" Column="1" TopLine="754"/>
     672        <Caret Line="328" Column="1" TopLine="319"/>
    655673      </Position29>
    656674      <Position30>
    657675        <Filename Value="../UMicroThreading.pas"/>
    658         <Caret Line="782" Column="1" TopLine="782"/>
     676        <Caret Line="329" Column="1" TopLine="319"/>
    659677      </Position30>
    660678    </JumpHistory>
    … …  
    696714  </CompilerOptions>
    697715  <Debugging>
     716    <BreakPoints Count="2">
     717      <Item1>
     718        <Source Value="../UMicroThreading.pas"/>
     719        <Line Value="869"/>
     720      </Item1>
     721      <Item2>
     722        <Source Value="../UMicroThreading.pas"/>
     723        <Line Value="325"/>
     724      </Item2>
     725    </BreakPoints>
    698726    <Watches Count="2">
    699727      <Item1>

  • MicroThreading/Demo/UMainForm.lfm

    r157 r158  
    1616    Top = 8
    1717    Width = 802
    18     ActivePage = TabSheet2
     18    ActivePage = TabSheet1
    1919    Anchors = [akTop, akLeft, akRight, akBottom]
    20     TabIndex = 0
     20    TabIndex = 1
    2121    TabOrder = 0
    2222    object TabSheet2: TTabSheet
    … …  
    133133          Height = 14
    134134          Top = 36
     135          Width = 13
     136          Caption = '    '
     137          ParentColor = False
     138        end
     139        object Label15: TLabel
     140          Left = 9
     141          Height = 14
     142          Top = 52
     143          Width = 83
     144          Caption = 'Main thread id:'
     145          ParentColor = False
     146        end
     147        object Label16: TLabel
     148          Left = 142
     149          Height = 14
     150          Top = 52
    135151          Width = 13
    136152          Caption = '    '
    … …  
    226242        Left = 10
    227243        Height = 25
    228         Top = 74
     244        Top = 223
    229245        Width = 104
    230246        Caption = 'Clear jobs'
    … …  
    236252        Height = 14
    237253        Top = 14
    238         Width = 34
     254        Width = 37
    239255        Caption = 'Count:'
    240256        ParentColor = False
    … …  
    253269      object Memo1: TMemo
    254270        Left = 316
    255         Height = 244
     271        Height = 243
    256272        Top = 14
    257273        Width = 294
    … …  
    261277      end
    262278      object Button1: TButton
    263         Left = 12
    264         Height = 25
    265         Top = 138
     279        Left = 230
     280        Height = 25
     281        Top = 239
    266282        Width = 75
    267283        Caption = 'Clear memo'
    … …  
    273289        Height = 14
    274290        Top = 38
    275         Width = 52
     291        Width = 57
    276292        Caption = 'Iterations:'
    277293        ParentColor = False
    … …  
    287303        Value = 10000000
    288304      end
     305      object GroupBox3: TGroupBox
     306        Left = 10
     307        Height = 137
     308        Top = 74
     309        Width = 292
     310        Caption = 'Do inside jobs'
     311        ClientHeight = 122
     312        ClientWidth = 288
     313        TabOrder = 6
     314        object CheckBox1: TCheckBox
     315          Left = 4
     316          Height = 20
     317          Top = 9
     318          Width = 76
     319          Caption = 'Use sleep'
     320          OnChange = CheckBox1Change
     321          TabOrder = 0
     322        end
     323        object SpinEdit4: TSpinEdit
     324          Left = 149
     325          Height = 21
     326          Top = 8
     327          Width = 90
     328          MaxValue = 100000
     329          TabOrder = 1
     330          Value = 100
     331        end
     332        object Label14: TLabel
     333          Left = 242
     334          Height = 14
     335          Top = 15
     336          Width = 17
     337          Caption = 'ms'
     338          ParentColor = False
     339        end
     340        object CheckBox2: TCheckBox
     341          Left = 5
     342          Height = 20
     343          Top = 32
     344          Width = 126
     345          Caption = 'Write test to memo'
     346          OnChange = CheckBox2Change
     347          TabOrder = 2
     348        end
     349        object CheckBox3: TCheckBox
     350          Left = 5
     351          Height = 20
     352          Top = 56
     353          Width = 98
     354          Caption = 'Wait for event'
     355          OnChange = CheckBox3Change
     356          TabOrder = 3
     357        end
     358        object Button3: TButton
     359          Left = 226
     360          Height = 25
     361          Top = 51
     362          Width = 51
     363          Caption = 'Signal'
     364          OnClick = Button3Click
     365          TabOrder = 4
     366        end
     367        object SpinEdit5: TSpinEdit
     368          Left = 130
     369          Height = 21
     370          Top = 51
     371          Width = 70
     372          MaxValue = 100000
     373          OnChange = CheckBox3Change
     374          TabOrder = 5
     375          Value = 100
     376        end
     377        object Label17: TLabel
     378          Left = 202
     379          Height = 14
     380          Top = 56
     381          Width = 17
     382          Caption = 'ms'
     383          ParentColor = False
     384        end
     385      end
    289386    end
    290387    object TabSheet3: TTabSheet

  • MicroThreading/Demo/UMainForm.pas

    r157 r158  
    1111type
    1212
     13  TMainForm = class;
     14
     15  { TWorker }
     16
     17  TWorker = class(TMicroThread)
     18    procedure Execute; override;
     19  private
     20    MainForm: TMainForm;
     21    procedure DoWriteToMemo;
     22  end;
     23
    1324  { TMainForm }
    1425
    … …  
    1627    Button1: TButton;
    1728    Button2: TButton;
     29    Button3: TButton;
    1830    ButtonAddWorkers: TButton;
    1931    ButtonClearMicroThreads: TButton;
    … …  
    2133    ButtonSchedulerStartStop: TButton;
    2234    ButtonShowThreadId: TButton;
     35    CheckBox1: TCheckBox;
     36    CheckBox2: TCheckBox;
     37    CheckBox3: TCheckBox;
    2338    CheckBoxUseMainThread: TCheckBox;
    2439    GroupBox1: TGroupBox;
    2540    GroupBox2: TGroupBox;
     41    GroupBox3: TGroupBox;
    2642    Label1: TLabel;
    2743    Label10: TLabel;
    … …  
    2945    Label12: TLabel;
    3046    Label13: TLabel;
     47    Label14: TLabel;
     48    Label15: TLabel;
     49    Label16: TLabel;
     50    Label17: TLabel;
    3151    Label2: TLabel;
    3252    Label3: TLabel;
    … …  
    4464    SpinEdit2: TSpinEdit;
    4565    SpinEdit3: TSpinEdit;
     66    SpinEdit4: TSpinEdit;
     67    SpinEdit5: TSpinEdit;
    4668    TabSheet1: TTabSheet;
    4769    TabSheet2: TTabSheet;
    … …  
    4971    TimerRedraw: TTimer;
    5072    procedure Button1Click(Sender: TObject);
     73    procedure Button3Click(Sender: TObject);
    5174    procedure ButtonSchedulerStartStopClick(Sender: TObject);
    5275    procedure Button2Click(Sender: TObject);
    … …  
    5578    procedure ButtonShowThreadIdClick(Sender: TObject);
    5679    procedure ButtonClearMicroThreadsClick(Sender: TObject);
     80    procedure CheckBox1Change(Sender: TObject);
     81    procedure CheckBox2Change(Sender: TObject);
     82    procedure CheckBox3Change(Sender: TObject);
    5783    procedure CheckBoxUseMainThreadChange(Sender: TObject);
    5884    procedure FormCreate(Sender: TObject);
    … …  
    6389    procedure SpinEdit2Change(Sender: TObject);
    6490    procedure SpinEdit3Change(Sender: TObject);
     91    procedure SpinEdit5Change(Sender: TObject);
    6592    procedure TimerRedrawTimer(Sender: TObject);
    6693  private
    67     procedure Worker(MicroThread: TMicroThread);
    68     procedure WorkerDoWrite;
    6994    procedure WorkerSubRoutine;
    7095  public
     96    DoWriteToMemo: Boolean;
     97    DoSleep: Boolean;
     98    SleepDuration: Integer;
     99    DoWaitForEvent: Boolean;
     100    Event: TMicroThreadEvent;
     101    WaitForEventDuration: Integer;
    71102    Iterations: Integer;
    72103  end;
    … …  
    88119  ListView1.DoubleBuffered := True;
    89120  Label6.Caption := IntToStr(GetLogicalProcessorCount);
     121  Event := TMicroThreadEvent.Create;
    90122end;
    91123
    … …  
    107139begin
    108140  Memo1.Clear;
     141end;
     142
     143procedure TMainForm.Button3Click(Sender: TObject);
     144begin
     145  Event.SetEvent;
    109146end;
    110147
    … …  
    165202var
    166203  I: Integer;
     204  NewWorker: TWorker;
    167205begin
    168206  //Scheduler.FMicroThreads.Clear;
    169   for I := 0 to SpinEdit1.Value - 1 do
    170     MainScheduler.AddMethod(Worker);
     207  for I := 0 to SpinEdit1.Value - 1 do begin
     208    NewWorker := TWorker.Create(True);
     209    NewWorker.MainForm := Self;
     210    NewWorker.Start;
     211  end;
    171212end;
    172213
    … …  
    203244end;
    204245
     246procedure TMainForm.CheckBox1Change(Sender: TObject);
     247begin
     248  SleepDuration := SpinEdit4.Value;
     249  DoSleep := CheckBox1.Checked;
     250end;
     251
     252procedure TMainForm.CheckBox2Change(Sender: TObject);
     253begin
     254  DoWriteToMemo := CheckBox2.Checked;
     255end;
     256
     257procedure TMainForm.CheckBox3Change(Sender: TObject);
     258begin
     259  DoWaitForEvent := CheckBox3.Checked;
     260  WaitForEventDuration := SpinEdit5.Value;
     261end;
     262
    205263procedure TMainForm.CheckBoxUseMainThreadChange(Sender: TObject);
    206264begin
    … …  
    211269begin
    212270  MainScheduler.Active := False;
     271  Event.Free;
    213272end;
    214273
    … …  
    216275begin
    217276  Iterations := SpinEdit3.Value;
    218   SpinEdit2.Value := 20;
     277  SpinEdit2.Value := 6;
    219278  ButtonAddWorkers.Click;
    220279  ButtonSchedulerStartStop.Click;
     280  Label16.Caption := IntToStr(MainThreadID);
    221281end;
    222282
    … …  
    267327end;
    268328
     329procedure TMainForm.SpinEdit5Change(Sender: TObject);
     330begin
     331
     332end;
     333
    269334procedure TMainForm.TimerRedrawTimer(Sender: TObject);
    270335begin
    … …  
    290355end;
    291356
    292 procedure TMainForm.Worker(MicroThread: TMicroThread);
     357procedure TWorker.Execute;
    293358var
    294359  I: Integer;
    295360  Q: Integer;
    296361begin
    297   with MicroThread do begin
    298     //Memo1.Lines.Add('Worker ' + IntToStr(Id));
    299     for I := 0 to Iterations - 1 do begin
    300       Q := 0;
    301       while Q < 100 do Inc(Q);
    302       //Synchronize(WorkerDoWrite);
    303       //Memo1.Lines.Add(IntToStr(Id) + ': ' + IntToStr(I) + ' ' +
    304       //  FloatToStr(ExecutionTime));
    305       Completion := I / Iterations;
    306       //MTSleep(1000 * OneMillisecond);
    307       Yield;
    308       //WorkerSubRoutine;
    309     end;
    310   end;
    311 end;
    312 
    313 procedure TMainForm.WorkerDoWrite;
    314 begin
    315   //Memo1.Lines.Add('.');
     362  for I := 0 to MainForm.Iterations - 1 do begin
     363    Q := 0;
     364    while Q < 100 do Inc(Q);
     365    if MainForm.DoWriteToMemo then Synchronize(DoWriteToMemo);
     366    if MainForm.DoWaitForEvent then MainForm.Event.WaitFor(MainForm.WaitForEventDuration * OneMillisecond);
     367    if MainForm.DoSleep then MTSleep(MainForm.SleepDuration * OneMillisecond);
     368    //WorkerSubRoutine;
     369    Completion := I / MainForm.Iterations;
     370    Yield;
     371  end;
     372end;
     373
     374procedure TWorker.DoWriteToMemo;
     375begin
     376  MainForm.Memo1.Lines.Add(IntToStr(Id) + ': ' + IntToStr(Trunc(Completion * 100)) + ' %');
    316377end;
    317378
Note: See TracChangeset for help on using the changeset viewer.