Changeset 162 for MicroThreading


Ignore:
Timestamp:
Feb 7, 2011, 1:04:27 PM (14 years ago)
Author:
george
Message:
  • Add: MicroThread critical section.
  • Add: Thread list to microthread list window.
Location:
MicroThreading
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • MicroThreading/Demo/Demo.lpi

    r161 r162  
    3131      </local>
    3232    </RunParams>
    33     <RequiredPackages Count="2">
     33    <RequiredPackages Count="3">
    3434      <Item1>
    35         <PackageName Value="Microthreading"/>
     35        <PackageName Value="LCLBase"/>
     36        <MinVersion Major="1" Release="1" Valid="True"/>
    3637      </Item1>
    3738      <Item2>
     39        <PackageName Value="Microthreading"/>
     40      </Item2>
     41      <Item3>
    3842        <PackageName Value="LCL"/>
    39       </Item2>
     43      </Item3>
    4044    </RequiredPackages>
    41     <Units Count="24">
     45    <Units Count="28">
    4246      <Unit0>
    4347        <Filename Value="Demo.lpr"/>
    … …  
    5559        <ResourceBaseClass Value="Form"/>
    5660        <UnitName Value="UMainForm"/>
    57         <EditorIndex Value="1"/>
    58         <WindowIndex Value="0"/>
    59         <TopLine Value="369"/>
    60         <CursorPos X="1" Y="379"/>
     61        <EditorIndex Value="6"/>
     62        <WindowIndex Value="0"/>
     63        <TopLine Value="372"/>
     64        <CursorPos X="21" Y="378"/>
    6165        <UsageCount Value="270"/>
    6266        <Loaded Value="True"/>
     67        <LoadedDesigner Value="True"/>
    6368      </Unit1>
    6469      <Unit2>
    … …  
    6873        <EditorIndex Value="0"/>
    6974        <WindowIndex Value="0"/>
    70         <TopLine Value="500"/>
    71         <CursorPos X="1" Y="517"/>
     75        <TopLine Value="976"/>
     76        <CursorPos X="18" Y="986"/>
    7277        <UsageCount Value="136"/>
    7378        <Loaded Value="True"/>
    … …  
    131136        <ResourceBaseClass Value="Form"/>
    132137        <UnitName Value="UMicroThreadList"/>
    133         <WindowIndex Value="0"/>
    134         <TopLine Value="1"/>
    135         <CursorPos X="44" Y="17"/>
    136         <UsageCount Value="21"/>
     138        <EditorIndex Value="4"/>
     139        <WindowIndex Value="0"/>
     140        <TopLine Value="83"/>
     141        <CursorPos X="84" Y="94"/>
     142        <UsageCount Value="23"/>
     143        <Loaded Value="True"/>
     144        <LoadedDesigner Value="True"/>
    137145      </Unit10>
    138146      <Unit11>
    … …  
    228236        <UsageCount Value="16"/>
    229237      </Unit23>
     238      <Unit24>
     239        <Filename Value="../../../../Projekty2/FreePascalManager/trunk/Instance/1/FPC/packages/fcl-base/src/syncobjs.pp"/>
     240        <UnitName Value="syncobjs"/>
     241        <EditorIndex Value="5"/>
     242        <WindowIndex Value="0"/>
     243        <TopLine Value="35"/>
     244        <CursorPos X="18" Y="45"/>
     245        <UsageCount Value="12"/>
     246        <Loaded Value="True"/>
     247      </Unit24>
     248      <Unit25>
     249        <Filename Value="../../../../Projekty2/FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/customlistview.inc"/>
     250        <EditorIndex Value="1"/>
     251        <WindowIndex Value="0"/>
     252        <TopLine Value="548"/>
     253        <CursorPos X="1" Y="561"/>
     254        <UsageCount Value="11"/>
     255        <Loaded Value="True"/>
     256      </Unit25>
     257      <Unit26>
     258        <Filename Value="../../../../Projekty2/FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/listitem.inc"/>
     259        <EditorIndex Value="2"/>
     260        <WindowIndex Value="0"/>
     261        <TopLine Value="798"/>
     262        <CursorPos X="1" Y="821"/>
     263        <UsageCount Value="11"/>
     264        <Loaded Value="True"/>
     265      </Unit26>
     266      <Unit27>
     267        <Filename Value="../../../../Projekty2/FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/listitems.inc"/>
     268        <EditorIndex Value="3"/>
     269        <WindowIndex Value="0"/>
     270        <TopLine Value="65"/>
     271        <CursorPos X="29" Y="75"/>
     272        <UsageCount Value="11"/>
     273        <Loaded Value="True"/>
     274      </Unit27>
    230275    </Units>
    231276    <JumpHistory Count="30" HistoryIndex="29">
    232277      <Position1>
    233278        <Filename Value="../UMicroThreading.pas"/>
    234         <Caret Line="462" Column="1" TopLine="451"/>
     279        <Caret Line="371" Column="16" TopLine="350"/>
    235280      </Position1>
    236281      <Position2>
    237282        <Filename Value="../UMicroThreading.pas"/>
    238         <Caret Line="463" Column="1" TopLine="451"/>
     283        <Caret Line="652" Column="38" TopLine="631"/>
    239284      </Position2>
    240285      <Position3>
    241286        <Filename Value="../UMicroThreading.pas"/>
    242         <Caret Line="434" Column="1" TopLine="423"/>
     287        <Caret Line="746" Column="12" TopLine="725"/>
    243288      </Position3>
    244289      <Position4>
    245290        <Filename Value="../UMicroThreading.pas"/>
    246         <Caret Line="462" Column="1" TopLine="451"/>
     291        <Caret Line="750" Column="31" TopLine="729"/>
    247292      </Position4>
    248293      <Position5>
    249294        <Filename Value="../UMicroThreading.pas"/>
    250         <Caret Line="463" Column="1" TopLine="451"/>
     295        <Caret Line="753" Column="26" TopLine="732"/>
    251296      </Position5>
    252297      <Position6>
    253298        <Filename Value="../UMicroThreading.pas"/>
    254         <Caret Line="545" Column="1" TopLine="534"/>
     299        <Caret Line="935" Column="13" TopLine="914"/>
    255300      </Position6>
    256301      <Position7>
    257302        <Filename Value="../UMicroThreading.pas"/>
    258         <Caret Line="429" Column="1" TopLine="418"/>
     303        <Caret Line="983" Column="31" TopLine="968"/>
    259304      </Position7>
    260305      <Position8>
    261306        <Filename Value="../UMicroThreading.pas"/>
    262         <Caret Line="430" Column="1" TopLine="418"/>
     307        <Caret Line="1013" Column="24" TopLine="992"/>
    263308      </Position8>
    264309      <Position9>
    265310        <Filename Value="../UMicroThreading.pas"/>
    266         <Caret Line="574" Column="1" TopLine="563"/>
     311        <Caret Line="8" Column="19" TopLine="1"/>
    267312      </Position9>
    268313      <Position10>
    269314        <Filename Value="../UMicroThreading.pas"/>
    270         <Caret Line="575" Column="1" TopLine="563"/>
     315        <Caret Line="652" Column="51" TopLine="639"/>
    271316      </Position10>
    272317      <Position11>
    273318        <Filename Value="../UMicroThreading.pas"/>
    274         <Caret Line="576" Column="1" TopLine="563"/>
     319        <Caret Line="645" Column="28" TopLine="639"/>
    275320      </Position11>
    276321      <Position12>
    277322        <Filename Value="../UMicroThreading.pas"/>
    278         <Caret Line="572" Column="1" TopLine="563"/>
     323        <Caret Line="653" Column="43" TopLine="639"/>
    279324      </Position12>
    280325      <Position13>
    281326        <Filename Value="../UMicroThreading.pas"/>
    282         <Caret Line="573" Column="1" TopLine="563"/>
     327        <Caret Line="479" Column="1" TopLine="466"/>
    283328      </Position13>
    284329      <Position14>
    285330        <Filename Value="../UMicroThreading.pas"/>
    286         <Caret Line="434" Column="1" TopLine="423"/>
     331        <Caret Line="712" Column="1" TopLine="699"/>
    287332      </Position14>
    288333      <Position15>
    289334        <Filename Value="../UMicroThreading.pas"/>
    290         <Caret Line="462" Column="1" TopLine="451"/>
     335        <Caret Line="582" Column="18" TopLine="571"/>
    291336      </Position15>
    292337      <Position16>
    293338        <Filename Value="../UMicroThreading.pas"/>
    294         <Caret Line="463" Column="1" TopLine="451"/>
     339        <Caret Line="583" Column="65" TopLine="571"/>
    295340      </Position16>
    296341      <Position17>
    297342        <Filename Value="../UMicroThreading.pas"/>
    298         <Caret Line="545" Column="30" TopLine="534"/>
     343        <Caret Line="582" Column="20" TopLine="571"/>
    299344      </Position17>
    300345      <Position18>
    301346        <Filename Value="../UMicroThreading.pas"/>
    302         <Caret Line="429" Column="1" TopLine="418"/>
     347        <Caret Line="583" Column="1" TopLine="571"/>
    303348      </Position18>
    304349      <Position19>
    305350        <Filename Value="../UMicroThreading.pas"/>
    306         <Caret Line="430" Column="1" TopLine="418"/>
     351        <Caret Line="711" Column="1" TopLine="698"/>
    307352      </Position19>
    308353      <Position20>
    309354        <Filename Value="../UMicroThreading.pas"/>
    310         <Caret Line="574" Column="1" TopLine="563"/>
     355        <Caret Line="712" Column="1" TopLine="698"/>
    311356      </Position20>
    312357      <Position21>
    313358        <Filename Value="../UMicroThreading.pas"/>
    314         <Caret Line="575" Column="1" TopLine="563"/>
     359        <Caret Line="713" Column="1" TopLine="698"/>
    315360      </Position21>
    316361      <Position22>
    317362        <Filename Value="../UMicroThreading.pas"/>
    318         <Caret Line="513" Column="34" TopLine="504"/>
     363        <Caret Line="714" Column="1" TopLine="698"/>
    319364      </Position22>
    320365      <Position23>
    321366        <Filename Value="../UMicroThreading.pas"/>
    322         <Caret Line="517" Column="1" TopLine="504"/>
     367        <Caret Line="715" Column="1" TopLine="698"/>
    323368      </Position23>
    324369      <Position24>
    325         <Filename Value="../UMicroThreading.pas"/>
    326         <Caret Line="545" Column="1" TopLine="534"/>
     370        <Filename Value="../UMicroThreadList.pas"/>
     371        <Caret Line="95" Column="54" TopLine="83"/>
    327372      </Position24>
    328373      <Position25>
    329         <Filename Value="UMainForm.pas"/>
    330         <Caret Line="379" Column="1" TopLine="369"/>
     374        <Filename Value="../UMicroThreading.pas"/>
     375        <Caret Line="240" Column="45" TopLine="227"/>
    331376      </Position25>
    332377      <Position26>
    333378        <Filename Value="../UMicroThreading.pas"/>
    334         <Caret Line="613" Column="1" TopLine="602"/>
     379        <Caret Line="984" Column="40" TopLine="979"/>
    335380      </Position26>
    336381      <Position27>
    337382        <Filename Value="../UMicroThreading.pas"/>
    338         <Caret Line="428" Column="6" TopLine="417"/>
     383        <Caret Line="992" Column="38" TopLine="979"/>
    339384      </Position27>
    340385      <Position28>
    341386        <Filename Value="../UMicroThreading.pas"/>
    342         <Caret Line="434" Column="3" TopLine="504"/>
     387        <Caret Line="989" Column="55" TopLine="976"/>
    343388      </Position28>
    344389      <Position29>
    345390        <Filename Value="../UMicroThreading.pas"/>
    346         <Caret Line="579" Column="1" TopLine="568"/>
     391        <Caret Line="990" Column="24" TopLine="976"/>
    347392      </Position29>
    348393      <Position30>
    349394        <Filename Value="../UMicroThreading.pas"/>
    350         <Caret Line="435" Column="1" TopLine="424"/>
     395        <Caret Line="989" Column="29" TopLine="976"/>
    351396      </Position30>
    352397    </JumpHistory>
    … …  
    389434  </CompilerOptions>
    390435  <Debugging>
    391     <BreakPoints Count="2">
     436    <BreakPoints Count="3">
    392437      <Item1>
    393438        <Source Value="../UMicroThreading.pas"/>
    394         <Line Value="261"/>
     439        <Line Value="280"/>
    395440      </Item1>
    396441      <Item2>
    … …  
    398443        <Line Value="1036"/>
    399444      </Item2>
     445      <Item3>
     446        <Source Value="../UMicroThreading.pas"/>
     447        <Line Value="321"/>
     448      </Item3>
    400449    </BreakPoints>
    401450    <Watches Count="2">

  • MicroThreading/Demo/UMainForm.lfm

    r160 r162  
    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
    … …  
    2626      object GroupBox1: TGroupBox
    2727        Left = 6
    28         Height = 81
     28        Height = 123
    2929        Top = 143
    3030        Width = 205
    3131        Caption = 'State'
    32         ClientHeight = 63
     32        ClientHeight = 105
    3333        ClientWidth = 201
    3434        TabOrder = 0
    … …  
    142142        end
    143143      end
    144       object ListView2: TListView
    145         Left = 6
    146         Height = 237
    147         Top = 247
    148         Width = 206
    149         Anchors = [akTop, akLeft, akBottom]
    150         Columns = <       
    151           item
    152             Caption = 'Id'
    153           end       
    154           item
    155             Caption = 'State'
    156             Width = 135
    157           end>
    158         OwnerData = True
    159         TabOrder = 2
    160         ViewStyle = vsReport
    161         OnData = ListView2Data
    162       end
    163       object Label13: TLabel
    164         Left = 7
    165         Height = 14
    166         Top = 233
    167         Width = 44
    168         Caption = 'Threads:'
    169         ParentColor = False
    170       end
    171144      object Button4: TButton
    172145        Left = 226
    … …  
    176149        Caption = 'Show manager'
    177150        OnClick = Button4Click
    178         TabOrder = 3
     151        TabOrder = 2
    179152      end
    180153    end
    … …  
    195168        Left = 10
    196169        Height = 25
    197         Top = 223
     170        Top = 266
    198171        Width = 104
    199172        Caption = 'Clear jobs'
    … …  
    230203      end
    231204      object Button1: TButton
    232         Left = 230
    233         Height = 25
    234         Top = 239
     205        Left = 316
     206        Height = 25
     207        Top = 266
    235208        Width = 75
    236209        Caption = 'Clear memo'
    … …  
    258231      object GroupBox3: TGroupBox
    259232        Left = 10
    260         Height = 137
     233        Height = 185
    261234        Top = 74
    262235        Width = 292
    263236        Caption = 'Do inside jobs'
    264         ClientHeight = 119
     237        ClientHeight = 167
    265238        ClientWidth = 288
    266239        TabOrder = 6
    … …  
    280253          Width = 90
    281254          MaxValue = 100000
     255          OnChange = CheckBox1Change
    282256          TabOrder = 1
    283257          Value = 100
    … …  
    345319          TabOrder = 6
    346320        end
     321        object CheckBox4: TCheckBox
     322          Left = 6
     323          Height = 17
     324          Top = 110
     325          Width = 123
     326          Caption = 'Wait in critical section'
     327          OnChange = CheckBox4Change
     328          TabOrder = 7
     329        end
     330        object SpinEdit6: TSpinEdit
     331          Left = 186
     332          Height = 21
     333          Top = 104
     334          Width = 70
     335          MaxValue = 100000
     336          OnChange = CheckBox4Change
     337          TabOrder = 8
     338          Value = 100
     339        end
     340        object Label18: TLabel
     341          Left = 264
     342          Height = 14
     343          Top = 110
     344          Width = 14
     345          Caption = 'ms'
     346          ParentColor = False
     347        end
    347348      end
    348349    end

  • MicroThreading/Demo/UMainForm.pas

    r161 r162  
    2020    MainForm: TMainForm;
    2121    procedure DoWriteToMemo;
     22    constructor Create(CreateSuspended: Boolean;
     23      const StackSize: SizeUInt = DefaultStackSize);
     24    destructor Destroy; override;
    2225  end;
    2326
    … …  
    3841    CheckBox2: TCheckBox;
    3942    CheckBox3: TCheckBox;
     43    CheckBox4: TCheckBox;
    4044    CheckBoxUseMainThread: TCheckBox;
    4145    GroupBox1: TGroupBox;
    … …  
    4549    Label11: TLabel;
    4650    Label12: TLabel;
    47     Label13: TLabel;
    4851    Label14: TLabel;
    4952    Label15: TLabel;
    5053    Label16: TLabel;
    5154    Label17: TLabel;
     55    Label18: TLabel;
    5256    Label2: TLabel;
    5357    Label3: TLabel;
    … …  
    5862    Label8: TLabel;
    5963    Label9: TLabel;
    60     ListView2: TListView;
    6164    Memo1: TMemo;
    6265    PageControl1: TPageControl;
    … …  
    6669    SpinEdit4: TSpinEdit;
    6770    SpinEdit5: TSpinEdit;
     71    SpinEdit6: TSpinEdit;
    6872    TabSheet1: TTabSheet;
    6973    TabSheet2: TTabSheet;
    … …  
    8387    procedure CheckBox2Change(Sender: TObject);
    8488    procedure CheckBox3Change(Sender: TObject);
     89    procedure CheckBox4Change(Sender: TObject);
    8590    procedure CheckBoxUseMainThreadChange(Sender: TObject);
    8691    procedure FormCreate(Sender: TObject);
    … …  
    9196    procedure SpinEdit3Change(Sender: TObject);
    9297    procedure SpinEdit5Change(Sender: TObject);
     98    procedure SpinEdit6Change(Sender: TObject);
    9399    procedure TimerRedrawTimer(Sender: TObject);
    94100  private
    95101    MicroThreadList: TMicroThreadList;
     102    Lock: TMicroThreadCriticalSection;
    96103    LastException: Exception;
    97104    LastExceptionSender: TObject;
    … …  
    102109    DoWriteToMemo: Boolean;
    103110    DoSleep: Boolean;
     111    DoCriticalSection: Boolean;
    104112    RaiseException: Boolean;
    105113    SleepDuration: Integer;
     114    CriticalSectionSleepDuration: Integer;
    106115    DoWaitForEvent: Boolean;
    107116    Event: TMicroThreadEvent;
    … …  
    129138  MicroThreadList := TMicroThreadList.Create(Self);
    130139  UMicroThreading.ExceptionHandler := ShowException;
     140  Lock := TMicroThreadCriticalSection.Create;
    131141end;
    132142
    … …  
    280290end;
    281291
     292procedure TMainForm.CheckBox4Change(Sender: TObject);
     293begin
     294  CriticalSectionSleepDuration := SpinEdit4.Value;
     295  DoCriticalSection := CheckBox4.Checked;
     296end;
     297
    282298procedure TMainForm.CheckBoxUseMainThreadChange(Sender: TObject);
    283299begin
    … …  
    290306  MainScheduler.Active := False;
    291307  Event.Free;
     308  Lock.Free;
    292309end;
    293310
    … …  
    303320procedure TMainForm.ListView2Data(Sender: TObject; Item: TListItem);
    304321begin
    305   if Item.Index < MainScheduler.ThreadPoolCount then
    306   try
    307     MainScheduler.ThreadPoolLock.Acquire;
    308     with TMicroThreadThread(MainScheduler.ThreadPool[Item.Index]) do begin
    309       Item.Caption := IntToStr(ThreadID);
    310       Item.SubItems.Add(MicroThreadThreadStateText[State]);
    311     end;
    312   finally
    313     MainScheduler.ThreadPoolLock.Release;
    314   end;
    315322end;
    316323
    … …  
    330337end;
    331338
     339procedure TMainForm.SpinEdit6Change(Sender: TObject);
     340begin
     341end;
     342
    332343procedure TMainForm.TimerRedrawTimer(Sender: TObject);
    333344begin
    334   if ListView2.Items.Count <> MainScheduler.ThreadPoolCount then
    335     ListView2.Items.Count := MainScheduler.ThreadPoolCount;
    336   ListView2.Items[-1];
    337   ListView2.Refresh;
    338 
    339345  Label2.Caption := DateTimeToStr(NowPrecise) + ' ' +
    340346    FloatToStr(Frac(NowPrecise / OneSecond));
    … …  
    369375begin
    370376  for I := 0 to MainForm.Iterations - 1 do begin
    371     try
    372377    Q := 0;
    373     while Q < 100 do Inc(Q);
     378    while Q < 100000 do Inc(Q);
    374379    if MainForm.DoWriteToMemo then Synchronize(DoWriteToMemo);
    375380    if MainForm.DoWaitForEvent then MainForm.Event.WaitFor(MainForm.WaitForEventDuration * OneMillisecond);
    … …  
    379384      raise Exception.Create('Exception from microthread');
    380385    end;
     386    if MainForm.DoCriticalSection then begin
     387      try
     388        MainForm.Lock.Acquire;
     389        MTSleep(MainForm.CriticalSectionSleepDuration * OneMillisecond);
     390      finally
     391        MainForm.Lock.Release;
     392      end;
     393    end;
    381394    //WorkerSubRoutine;
    382395    Completion := I / MainForm.Iterations;
    383396    Yield;
    384 
    385     except
    386       Q := 0;
    387       raise  Exception.Create('Exception from microthread');
    388     end;
    389397  end;
    390398end;
    … …  
    395403end;
    396404
     405constructor TWorker.Create(CreateSuspended: Boolean; const StackSize: SizeUInt);
     406begin
     407  inherited;
     408end;
     409
     410destructor TWorker.Destroy;
     411begin
     412  inherited Destroy;
     413end;
     414
    397415end.
    398416

  • MicroThreading/MicroThreading.lpk

    r160 r162  
    55    <Author Value="Chronos"/>
    66    <CompilerOptions>
    7       <Version Value="9"/>
     7      <Version Value="10"/>
    88      <SearchPaths>
    99        <OtherUnitFiles Value="Other"/>
    … …  
    4141    </Files>
    4242    <Type Value="RunAndDesignTime"/>
    43     <RequiredPkgs Count="2">
     43    <RequiredPkgs Count="4">
    4444      <Item1>
    45         <PackageName Value="LCL"/>
     45        <PackageName Value="LCLBase"/>
    4646      </Item1>
    4747      <Item2>
     48        <PackageName Value="LCLBase"/>
     49      </Item2>
     50      <Item3>
     51        <PackageName Value="LCL"/>
     52      </Item3>
     53      <Item4>
    4854        <PackageName Value="FCL"/>
    4955        <MinVersion Major="1" Valid="True"/>
    50       </Item2>
     56      </Item4>
    5157    </RequiredPkgs>
    5258    <UsageOptions>

  • MicroThreading/UMicroThreadList.lfm

    r159 r162  
    11object MicroThreadListForm: TMicroThreadListForm
    2   Left = 267
     2  Left = 367
    33  Height = 423
    44  Top = 118
    … …  
    1010  OnShow = FormShow
    1111  LCLVersion = '0.9.31'
    12   object ListView1: TListView
    13     Left = 8
    14     Height = 410
    15     Top = 8
    16     Width = 557
    17     Anchors = [akTop, akLeft, akRight, akBottom]
    18     Columns = <   
    19       item
    20         Caption = 'Id'
    21         Width = 40
    22       end   
    23       item
    24         Caption = 'Usage'
    25       end   
    26       item
    27         Caption = 'Priority'
    28         Width = 40
    29       end   
    30       item
    31         Caption = 'State'
    32         Width = 60
    33       end   
    34       item
    35         Caption = 'Block state'
    36       end   
    37       item
    38         Caption = 'Execution time'
    39         Width = 70
    40       end   
    41       item
    42         Caption = 'Tick count'
    43       end   
    44       item
    45         Caption = 'Completion'
    46       end   
    47       item
    48         Caption = 'Used stack'
    49       end   
    50       item
    51         Caption = 'Name'
    52         Width = 70
    53       end>
    54     OwnerData = True
    55     ReadOnly = True
    56     RowSelect = True
     12  object Panel1: TPanel
     13    Left = 0
     14    Height = 248
     15    Top = 0
     16    Width = 569
     17    Align = alTop
     18    BevelOuter = bvNone
     19    ClientHeight = 248
     20    ClientWidth = 569
    5721    TabOrder = 0
    58     ViewStyle = vsReport
    59     OnData = ListView1Data
     22    object Label1: TLabel
     23      Left = 8
     24      Height = 14
     25      Top = 8
     26      Width = 67
     27      Caption = 'Microthreads:'
     28      ParentColor = False
     29    end
     30    object ListView1: TListView
     31      Left = 8
     32      Height = 218
     33      Top = 24
     34      Width = 557
     35      Anchors = [akTop, akLeft, akRight, akBottom]
     36      Columns = <     
     37        item
     38          Caption = 'Id'
     39          Width = 40
     40        end     
     41        item
     42          Caption = 'Usage'
     43        end     
     44        item
     45          Caption = 'Priority'
     46          Width = 40
     47        end     
     48        item
     49          Caption = 'State'
     50          Width = 60
     51        end     
     52        item
     53          Caption = 'Block state'
     54        end     
     55        item
     56          Caption = 'Execution time'
     57          Width = 70
     58        end     
     59        item
     60          Caption = 'Tick count'
     61        end     
     62        item
     63          Caption = 'Completion'
     64        end     
     65        item
     66          Caption = 'Used stack'
     67        end     
     68        item
     69          Caption = 'Name'
     70          Width = 70
     71        end>
     72      OwnerData = True
     73      ReadOnly = True
     74      RowSelect = True
     75      TabOrder = 0
     76      ViewStyle = vsReport
     77      OnData = ListView1Data
     78    end
     79  end
     80  object Panel2: TPanel
     81    Left = 0
     82    Height = 170
     83    Top = 253
     84    Width = 569
     85    Align = alClient
     86    BevelOuter = bvNone
     87    ClientHeight = 170
     88    ClientWidth = 569
     89    TabOrder = 1
     90    object ListView2: TListView
     91      Left = 8
     92      Height = 142
     93      Top = 19
     94      Width = 557
     95      Anchors = [akTop, akLeft, akRight, akBottom]
     96      Columns = <     
     97        item
     98          Caption = 'Id'
     99        end     
     100        item
     101          Caption = 'State'
     102          Width = 100
     103        end     
     104        item
     105          Caption = 'Microthread Id'
     106          Width = 70
     107        end     
     108        item
     109          Caption = 'Loop duration'
     110          Width = 70
     111        end>
     112      OwnerData = True
     113      ReadOnly = True
     114      RowSelect = True
     115      TabOrder = 0
     116      ViewStyle = vsReport
     117      OnData = ListView2Data
     118    end
     119    object Label2: TLabel
     120      Left = 8
     121      Height = 14
     122      Top = 3
     123      Width = 44
     124      Caption = 'Threads:'
     125      ParentColor = False
     126    end
     127  end
     128  object Splitter1: TSplitter
     129    Cursor = crVSplit
     130    Left = 0
     131    Height = 5
     132    Top = 248
     133    Width = 569
     134    Align = alTop
     135    ResizeAnchor = akTop
    60136  end
    61137  object TimerRedraw: TTimer

  • MicroThreading/UMicroThreadList.pas

    r159 r162  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    9   ExtCtrls;
     9  ExtCtrls, StdCtrls, DateUtils;
    1010
    1111type
    … …  
    1414
    1515  TMicroThreadListForm = class(TForm)
     16    Label1: TLabel;
     17    Label2: TLabel;
    1618    ListView1: TListView;
     19    ListView2: TListView;
     20    Panel1: TPanel;
     21    Panel2: TPanel;
     22    Splitter1: TSplitter;
    1723    TimerRedraw: TTimer;
    1824    procedure FormHide(Sender: TObject);
    1925    procedure FormShow(Sender: TObject);
    2026    procedure ListView1Data(Sender: TObject; Item: TListItem);
     27    procedure ListView2Data(Sender: TObject; Item: TListItem);
    2128    procedure TimerRedrawTimer(Sender: TObject);
    2229  private
    … …  
    3643
    3744procedure TMicroThreadListForm.TimerRedrawTimer(Sender: TObject);
     45var
     46  ThreadCount: Integer;
    3847begin
    3948  if ListView1.Items.Count <> MainScheduler.MicroThreadCount then
    … …  
    4150  ListView1.Items[-1];
    4251  ListView1.Refresh;
     52
     53  ThreadCount := MainScheduler.ThreadPoolCount;
     54  if MainScheduler.UseMainThread then Inc(ThreadCount);
     55  if ListView2.Items.Count <> ThreadCount then
     56    ListView2.Items.Count := ThreadCount;
     57  ListView2.Items[-1];
     58  ListView2.Refresh;
    4359end;
    4460
    … …  
    6682end;
    6783
     84procedure TMicroThreadListForm.ListView2Data(Sender: TObject; Item: TListItem);
     85var
     86  Increment: Integer;
     87begin
     88  if MainScheduler.UseMainThread then Increment := 1
     89    else Increment := 0;
     90
     91  if Item.Index < (MainScheduler.ThreadPoolCount + Increment) then begin
     92    if MainScheduler.UseMainThread and (Item.Index = 0) then begin
     93      Item.Caption := IntToStr(MainThreadID);
     94      Item.SubItems.Add('');
     95      Item.SubItems.Add(IntToStr(MainScheduler.MainThreadManager.GetCurrentMicroThreadId));
     96      Item.SubItems.Add(FloatToStr(MainScheduler.MainThreadManager.LoopDuration / OneMillisecond) + ' ms');
     97    end else
     98    try
     99      MainScheduler.ThreadPoolLock.Acquire;
     100      with TMicroThreadThread(MainScheduler.ThreadPool[Item.Index - Increment]) do begin
     101        Item.Caption := IntToStr(ThreadID);
     102        Item.SubItems.Add(MicroThreadThreadStateText[State]);
     103        Item.SubItems.Add(IntToStr(Manager.GetCurrentMicroThreadId));
     104        Item.SubItems.Add(FloatToStr(Manager.LoopDuration / OneMillisecond) + ' ms');
     105      end;
     106    finally
     107      MainScheduler.ThreadPoolLock.Release;
     108    end;
     109  end;
     110end;
     111
    68112procedure TMicroThreadListForm.FormShow(Sender: TObject);
    69113begin

  • MicroThreading/UMicroThreading.pas

    r161 r162  
    1 (* Not implemented yet
     1// Date: 2010-02-07
     2
     3(*
     4Not implemented yet
    25- Stack limit checking
    36- measurement of cpu usage by micro threads
    4 - microthread critical sections (no low level cpu blocking)
    5 - wait for single and multiple objects
    6 - micro thread priorty
     7- wait for multiple objects
     8- micro thread priority
    79*)
    810
    … …  
    3133  SCantDetermineThreadID = 'Can''t determine thread for id %d';
    3234  SNotInThread = 'Not in thread';
     35  SReleaseNotAcquiredLock = 'Release not acquired lock';
    3336
    3437
    … …  
    4144  TMicroThreadBlockState = (tbsNone, tbsSleeping, tbsWaitFor, tbsTerminating,
    4245    tbsTerminated);
     46
     47  { TMicroThreadCriticalSection }
     48
     49  TMicroThreadCriticalSection = class
     50    Lock: TCriticalSection;
     51    Counter: Integer;
     52    procedure Acquire;
     53    procedure Release;
     54    constructor Create;
     55    destructor Destroy; override;
     56  end;
    4357
    4458  { TMicroThreadEvent }
    … …  
    5367    procedure SetEvent;
    5468    procedure ResetEvent;
    55     procedure WaitFor(Duration: TDateTime);
     69    function WaitFor(Duration: TDateTime): TWaitResult;
    5670    constructor Create;
    5771    destructor Destroy; override;
    … …  
    7084    FExecutionCount: Integer;
    7185    FStack: Pointer;
    72     FStackPointer: Pointer;
     86    FStackPointer: Pointer; // Register SP
    7387    FStackSize: Integer;
    74     FBasePointer: Pointer;
     88    FBasePointer: Pointer; // Register BP
    7589    FExceptObjectStack: PExceptObject;
    7690    FExceptAddrStack: PExceptAddr;
    … …  
    160174    FThread: TMicroThreadThread;
    161175    FId: Integer;
     176    FLoopDuration: TDateTime;
     177    FLoopStart: TDateTime;
    162178    procedure SetCurrentMicroThread(const AValue: TMicroThread);
    163179    function Execute(Count: Integer): Integer;
    … …  
    170186    destructor Destroy; override;
    171187    property Scheduler: TMicroThreadScheduler read FScheduler;
     188    property LoopDuration: TDateTime read FLoopDuration;
     189    function GetCurrentMicroThreadId: Integer;
    172190  end;
    173191
    … …  
    206224    procedure MainThreadTick(Data: PtrInt);
    207225  public
     226    BurstCount: Integer;
    208227    function Add(MicroThread: TMicroThread): Integer;
    209228    function AddMethod(Method: TMicroThreadMethod): Integer;
    … …  
    343362end;
    344363
     364{ TMicroThreadCriticalSection }
     365
     366procedure TMicroThreadCriticalSection.Acquire;
     367begin
     368  try
     369    Lock.Acquire;
     370    while Counter > 0 do begin
     371      try
     372        Lock.Release;
     373        MTSleep(1 * OneMillisecond);
     374      finally
     375        Lock.Acquire;
     376      end;
     377    end;
     378    Inc(Counter);
     379  finally
     380    Lock.Release;
     381  end;
     382end;
     383
     384procedure TMicroThreadCriticalSection.Release;
     385begin
     386  try
     387    Lock.Acquire;
     388    if Counter > 0 then Dec(Counter)
     389      else raise Exception.Create(SReleaseNotAcquiredLock);
     390  finally
     391    Lock.Release;
     392  end;
     393end;
     394
     395constructor TMicroThreadCriticalSection.Create;
     396begin
     397  Lock := TCriticalSection.Create;
     398end;
     399
     400destructor TMicroThreadCriticalSection.Destroy;
     401begin
     402  Acquire;
     403  Lock.Free;
     404  inherited Destroy;
     405end;
     406
    345407{ TMicroThreadList }
    346408
    … …  
    363425    for I := 0 to FMicroThreads.Count - 1 do
    364426    with TMicroThread(FMicroThreads[I]) do begin
    365       if (FState = tsBlocked) and (FBlockState = tbsWaitFor) then
     427      if (FState = tsBlocked) and (FBlockState = tbsWaitFor) then begin
    366428        FState := tsWaiting;
     429        FBlockTime := 0; // Set signaled state using block time variable
     430      end;
    367431    end;
    368432    if not FAutoReset then FSignaled := True;
    … …  
    377441end;
    378442
    379 procedure TMicroThreadEvent.WaitFor(Duration: TDateTime);
     443function TMicroThreadEvent.WaitFor(Duration: TDateTime): TWaitResult;
    380444var
    381445  MT: TMicroThread;
    382446begin
    383447  MT := GetCurrentMicroThread;
    384   if Assigned(MT) then MT.WaitForEvent(Self, Duration);
     448  if Assigned(MT) then Result := MT.WaitForEvent(Self, Duration)
     449    else Result := wrSignaled;
    385450end;
    386451
    … …  
    422487function TMicroThreadManager.Execute(Count: Integer): Integer;
    423488begin
     489  FLoopStart := NowPrecise;
    424490  FStack := StackBottom;
    425491  FStackSize := StackBottom + StackLength;
    … …  
    428494  Yield;
    429495  Result := FExecutedCount;
     496  FLoopDuration := NowPrecise - FLoopStart;
    430497end;
    431498
    … …  
    489556          mov ebp, ebx
    490557          // We want to call virtual method Execute
    491           // but virtual methods can be called only statically
     558          // but methods can be called only statically from assembler
    492559          // Then static method CallExecute is calling virtual method Execute
    493560          call TMicroThread.CallExecute
    … …  
    515582            FMicroThreadsLock.Acquire;
    516583            FMicroThreads.Delete(FMicroThreads.IndexOf(FCurrentMicroThread));
    517             FCurrentMicroThread.Manager := nil;
     584            FCurrentMicroThread := nil;
    518585          finally
    519586            FMicroThreadsLock.Release;
    … …  
    562629end;
    563630
     631function TMicroThreadManager.GetCurrentMicroThreadId: Integer;
     632begin
     633  try
     634    FScheduler.FMicroThreadsLock.Acquire;
     635    if Assigned(FCurrentMicroThread) then
     636      Result := FCurrentMicroThread.Id
     637      else Result := 0;
     638  finally
     639    FScheduler.FMicroThreadsLock.Release;
     640  end;
     641end;
     642
    564643{ TMicroThreadThread }
    565644
    … …  
    571650    repeat
    572651      State := ttsRunning;
    573       ExecutedCount := Manager.Execute(10);
     652      ExecutedCount := Manager.Execute(MainScheduler.BurstCount);
    574653      State := ttsReady;
    575654      if ExecutedCount = 0 then Sleep(1);
    … …  
    691770  end;
    692771  Yield;
    693   if FBlockTime < NowPrecise then
    694     Result := wrTimeout else Result := wrSignaled;
     772  if (FBlockTime <> 0) and (FBlockTime < NowPrecise) then Result := wrTimeout
     773    else Result := wrSignaled;
    695774
    696775  try
    … …  
    811890  FMainThreadManager.FScheduler := Self;
    812891  UseMainThread := False;
     892  BurstCount := 100;
    813893end;
    814894
    … …  
    900980var
    901981  Executed: Integer;
     982  StartTime: TDateTime;
     983  Duration: TDateTime;
    902984begin
    903985//  try
    904     Executed := FMainThreadManager.Execute(1);
    905     if Executed = 0 then Sleep(1);
     986    Duration := 100 * OneMillisecond;
     987    StartTime := NowPrecise;
     988    Executed := -1;
     989    while (Executed <> 0) and ((NowPrecise - StartTime) < Duration) do begin
     990      Executed := FMainThreadManager.Execute(BurstCount);
     991    end;
     992    //if Executed = 0 then Sleep(1);
    906993    // If not terminated then queue next tick else terminate
    907994    if (FState = ssRunning) and FUseMainThread then
Note: See TracChangeset for help on using the changeset viewer.