Changeset 149


Ignore:
Timestamp:
Jan 26, 2011, 7:12:08 PM (14 years ago)
Author:
george
Message:
  • Moved: Global function with platform depending implementation moved to UPlatform unit.
  • Modifed: Demo form restructuralized to tabs with separate pages.
Location:
MicroThreading
Files:
1 added
7 edited

Legend:

Unmodified
Added
Removed

  • MicroThreading/Demo/Demo.lpi

    r148 r149  
    3131      </local>
    3232    </RunParams>
    33     <RequiredPackages Count="3">
     33    <RequiredPackages Count="2">
    3434      <Item1>
    35         <PackageName Value="ExceptionLogger"/>
     35        <PackageName Value="Microthreading"/>
    3636      </Item1>
    3737      <Item2>
    38         <PackageName Value="Microthreading"/>
     38        <PackageName Value="LCL"/>
    3939      </Item2>
    40       <Item3>
    41         <PackageName Value="LCL"/>
    42       </Item3>
    4340    </RequiredPackages>
    44     <Units Count="48">
     41    <Units Count="51">
    4542      <Unit0>
    4643        <Filename Value="Demo.lpr"/>
    4744        <IsPartOfProject Value="True"/>
    4845        <UnitName Value="Demo"/>
     46        <IsVisibleTab Value="True"/>
     47        <EditorIndex Value="1"/>
    4948        <WindowIndex Value="0"/>
    5049        <TopLine Value="1"/>
    51         <CursorPos X="1" Y="15"/>
    52         <UsageCount Value="53"/>
     50        <CursorPos X="10" Y="7"/>
     51        <UsageCount Value="58"/>
     52        <Loaded Value="True"/>
    5353      </Unit0>
    5454      <Unit1>
    … …  
    6060        <EditorIndex Value="0"/>
    6161        <WindowIndex Value="0"/>
    62         <TopLine Value="70"/>
    63         <CursorPos X="18" Y="80"/>
    64         <UsageCount Value="53"/>
     62        <TopLine Value="1"/>
     63        <CursorPos X="20" Y="226"/>
     64        <UsageCount Value="58"/>
    6565        <Loaded Value="True"/>
    6666        <LoadedDesigner Value="True"/>
    … …  
    6969        <Filename Value="../UMicroThreading.pas"/>
    7070        <UnitName Value="UMicroThreading"/>
    71         <IsVisibleTab Value="True"/>
    72         <EditorIndex Value="4"/>
    73         <WindowIndex Value="0"/>
    74         <TopLine Value="621"/>
    75         <CursorPos X="1" Y="621"/>
    76         <UsageCount Value="30"/>
     71        <EditorIndex Value="3"/>
     72        <WindowIndex Value="0"/>
     73        <TopLine Value="352"/>
     74        <CursorPos X="1" Y="367"/>
     75        <UsageCount Value="32"/>
    7776        <Loaded Value="True"/>
    7877      </Unit2>
    … …  
    111110        <Filename Value="../../ExceptionLogger/UExceptionLogger.pas"/>
    112111        <UnitName Value="UExceptionLogger"/>
    113         <WindowIndex Value="0"/>
    114         <TopLine Value="8"/>
    115         <CursorPos X="1" Y="1"/>
    116         <UsageCount Value="8"/>
     112        <EditorIndex Value="4"/>
     113        <WindowIndex Value="0"/>
     114        <TopLine Value="1"/>
     115        <CursorPos X="1" Y="8"/>
     116        <UsageCount Value="10"/>
     117        <Loaded Value="True"/>
    117118        <DefaultSyntaxHighlighter Value="Delphi"/>
    118119      </Unit7>
    … …  
    145146      <Unit11>
    146147        <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/inc/systemh.inc"/>
    147         <WindowIndex Value="0"/>
    148         <TopLine Value="886"/>
    149         <CursorPos X="20" Y="900"/>
    150         <UsageCount Value="8"/>
     148        <EditorIndex Value="2"/>
     149        <WindowIndex Value="0"/>
     150        <TopLine Value="479"/>
     151        <CursorPos X="3" Y="494"/>
     152        <UsageCount Value="11"/>
     153        <Loaded Value="True"/>
    151154      </Unit11>
    152155      <Unit12>
    … …  
    195198      <Unit18>
    196199        <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/objpas/classes/classesh.inc"/>
    197         <WindowIndex Value="0"/>
    198         <TopLine Value="1368"/>
    199         <CursorPos X="3" Y="1385"/>
    200         <UsageCount Value="10"/>
     200        <EditorIndex Value="6"/>
     201        <WindowIndex Value="0"/>
     202        <TopLine Value="1425"/>
     203        <CursorPos X="25" Y="1443"/>
     204        <UsageCount Value="12"/>
     205        <Loaded Value="True"/>
    201206      </Unit18>
    202207      <Unit19>
    … …  
    238243      <Unit24>
    239244        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/sysutils/datih.inc"/>
    240         <EditorIndex Value="7"/>
    241245        <WindowIndex Value="0"/>
    242246        <TopLine Value="106"/>
    243247        <CursorPos X="10" Y="119"/>
    244248        <UsageCount Value="19"/>
    245         <Loaded Value="True"/>
    246249      </Unit24>
    247250      <Unit25>
    … …  
    298301      <Unit32>
    299302        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/classesh.inc"/>
    300         <EditorIndex Value="8"/>
    301303        <WindowIndex Value="0"/>
    302304        <TopLine Value="1504"/>
    303305        <CursorPos X="1" Y="1510"/>
    304306        <UsageCount Value="16"/>
    305         <Loaded Value="True"/>
    306307      </Unit32>
    307308      <Unit33>
    … …  
    328329      <Unit36>
    329330        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/classes/classes.inc"/>
    330         <EditorIndex Value="9"/>
    331331        <WindowIndex Value="0"/>
    332332        <TopLine Value="109"/>
    333333        <CursorPos X="3" Y="111"/>
    334334        <UsageCount Value="16"/>
    335         <Loaded Value="True"/>
    336335      </Unit36>
    337336      <Unit37>
    338337        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/inc/objpash.inc"/>
    339         <EditorIndex Value="1"/>
    340338        <WindowIndex Value="0"/>
    341339        <TopLine Value="181"/>
    342340        <CursorPos X="21" Y="194"/>
    343341        <UsageCount Value="13"/>
    344         <Loaded Value="True"/>
    345342      </Unit37>
    346343      <Unit38>
    … …  
    388385      <Unit44>
    389386        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/lcl/include/spinedit.inc"/>
    390         <EditorIndex Value="3"/>
    391387        <WindowIndex Value="0"/>
    392388        <TopLine Value="221"/>
    393389        <CursorPos X="1" Y="235"/>
    394390        <UsageCount Value="13"/>
    395         <Loaded Value="True"/>
    396391      </Unit44>
    397392      <Unit45>
    398393        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/lcl/interfaces/win32/win32object.inc"/>
    399         <EditorIndex Value="6"/>
    400394        <WindowIndex Value="0"/>
    401395        <TopLine Value="387"/>
    402396        <CursorPos X="1" Y="400"/>
    403397        <UsageCount Value="13"/>
    404         <Loaded Value="True"/>
    405398      </Unit45>
    406399      <Unit46>
    407400        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/wininc/struct.inc"/>
    408         <EditorIndex Value="5"/>
    409401        <WindowIndex Value="0"/>
    410402        <TopLine Value="6081"/>
    411403        <CursorPos X="6" Y="6094"/>
    412404        <UsageCount Value="13"/>
    413         <Loaded Value="True"/>
    414405      </Unit46>
    415406      <Unit47>
    416407        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/inc/objpas.inc"/>
    417         <EditorIndex Value="2"/>
    418408        <WindowIndex Value="0"/>
    419409        <TopLine Value="160"/>
    420410        <CursorPos X="12" Y="163"/>
    421411        <UsageCount Value="10"/>
    422         <Loaded Value="True"/>
    423412      </Unit47>
     413      <Unit48>
     414        <Filename Value="../UPlatform.pas"/>
     415        <UnitName Value="UPlatform"/>
     416        <EditorIndex Value="7"/>
     417        <WindowIndex Value="0"/>
     418        <TopLine Value="1"/>
     419        <CursorPos X="24" Y="9"/>
     420        <UsageCount Value="12"/>
     421        <Loaded Value="True"/>
     422      </Unit48>
     423      <Unit49>
     424        <Filename Value="../../../../lazarus/lcl/interfaces/gtk2/gtk2winapi.inc"/>
     425        <WindowIndex Value="0"/>
     426        <TopLine Value="9153"/>
     427        <CursorPos X="8" Y="9166"/>
     428        <UsageCount Value="10"/>
     429      </Unit49>
     430      <Unit50>
     431        <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/unix/sysutils.pp"/>
     432        <UnitName Value="sysutils"/>
     433        <EditorIndex Value="5"/>
     434        <WindowIndex Value="0"/>
     435        <TopLine Value="1"/>
     436        <CursorPos X="1" Y="1"/>
     437        <UsageCount Value="10"/>
     438        <Loaded Value="True"/>
     439      </Unit50>
    424440    </Units>
    425441    <JumpHistory Count="30" HistoryIndex="29">
    426442      <Position1>
    427443        <Filename Value="../UMicroThreading.pas"/>
    428         <Caret Line="551" Column="1" TopLine="537"/>
     444        <Caret Line="524" Column="1" TopLine="509"/>
    429445      </Position1>
    430446      <Position2>
    431447        <Filename Value="../UMicroThreading.pas"/>
    432         <Caret Line="552" Column="1" TopLine="537"/>
     448        <Caret Line="530" Column="28" TopLine="515"/>
    433449      </Position2>
    434450      <Position3>
    435451        <Filename Value="../UMicroThreading.pas"/>
    436         <Caret Line="555" Column="1" TopLine="537"/>
     452        <Caret Line="547" Column="1" TopLine="532"/>
    437453      </Position3>
    438454      <Position4>
    439455        <Filename Value="../UMicroThreading.pas"/>
    440         <Caret Line="558" Column="1" TopLine="537"/>
     456        <Caret Line="570" Column="1" TopLine="555"/>
    441457      </Position4>
    442458      <Position5>
    443459        <Filename Value="../UMicroThreading.pas"/>
    444         <Caret Line="563" Column="1" TopLine="540"/>
     460        <Caret Line="661" Column="1" TopLine="646"/>
    445461      </Position5>
    446462      <Position6>
    447463        <Filename Value="../UMicroThreading.pas"/>
    448         <Caret Line="623" Column="1" TopLine="610"/>
     464        <Caret Line="662" Column="1" TopLine="646"/>
    449465      </Position6>
    450466      <Position7>
    451467        <Filename Value="../UMicroThreading.pas"/>
    452         <Caret Line="550" Column="1" TopLine="537"/>
     468        <Caret Line="663" Column="1" TopLine="646"/>
    453469      </Position7>
    454470      <Position8>
    455471        <Filename Value="../UMicroThreading.pas"/>
    456         <Caret Line="551" Column="1" TopLine="537"/>
     472        <Caret Line="570" Column="1" TopLine="555"/>
    457473      </Position8>
    458474      <Position9>
    459475        <Filename Value="../UMicroThreading.pas"/>
    460         <Caret Line="552" Column="1" TopLine="537"/>
     476        <Caret Line="571" Column="1" TopLine="555"/>
    461477      </Position9>
    462478      <Position10>
    463479        <Filename Value="../UMicroThreading.pas"/>
    464         <Caret Line="556" Column="1" TopLine="537"/>
     480        <Caret Line="572" Column="1" TopLine="555"/>
    465481      </Position10>
    466482      <Position11>
    467483        <Filename Value="../UMicroThreading.pas"/>
    468         <Caret Line="558" Column="1" TopLine="537"/>
     484        <Caret Line="573" Column="1" TopLine="555"/>
    469485      </Position11>
    470486      <Position12>
    471487        <Filename Value="../UMicroThreading.pas"/>
    472         <Caret Line="561" Column="1" TopLine="539"/>
     488        <Caret Line="574" Column="1" TopLine="555"/>
    473489      </Position12>
    474490      <Position13>
    475491        <Filename Value="../UMicroThreading.pas"/>
    476         <Caret Line="559" Column="3" TopLine="543"/>
     492        <Caret Line="575" Column="1" TopLine="555"/>
    477493      </Position13>
    478494      <Position14>
    479495        <Filename Value="../UMicroThreading.pas"/>
    480         <Caret Line="564" Column="1" TopLine="543"/>
     496        <Caret Line="20" Column="3" TopLine="1"/>
    481497      </Position14>
    482498      <Position15>
    483499        <Filename Value="../UMicroThreading.pas"/>
    484         <Caret Line="562" Column="1" TopLine="543"/>
     500        <Caret Line="573" Column="1" TopLine="558"/>
    485501      </Position15>
    486502      <Position16>
    487503        <Filename Value="../UMicroThreading.pas"/>
    488         <Caret Line="563" Column="1" TopLine="543"/>
     504        <Caret Line="664" Column="1" TopLine="649"/>
    489505      </Position16>
    490506      <Position17>
    491507        <Filename Value="../UMicroThreading.pas"/>
    492         <Caret Line="564" Column="1" TopLine="543"/>
     508        <Caret Line="665" Column="1" TopLine="649"/>
    493509      </Position17>
    494510      <Position18>
    495511        <Filename Value="../UMicroThreading.pas"/>
    496         <Caret Line="562" Column="1" TopLine="543"/>
     512        <Caret Line="666" Column="1" TopLine="649"/>
    497513      </Position18>
    498514      <Position19>
    499515        <Filename Value="../UMicroThreading.pas"/>
    500         <Caret Line="563" Column="1" TopLine="543"/>
     516        <Caret Line="573" Column="1" TopLine="558"/>
    501517      </Position19>
    502518      <Position20>
    503519        <Filename Value="../UMicroThreading.pas"/>
    504         <Caret Line="564" Column="1" TopLine="543"/>
     520        <Caret Line="574" Column="1" TopLine="558"/>
    505521      </Position20>
    506522      <Position21>
    507523        <Filename Value="../UMicroThreading.pas"/>
    508         <Caret Line="562" Column="1" TopLine="543"/>
     524        <Caret Line="575" Column="1" TopLine="558"/>
    509525      </Position21>
    510526      <Position22>
    511527        <Filename Value="../UMicroThreading.pas"/>
    512         <Caret Line="563" Column="1" TopLine="543"/>
     528        <Caret Line="576" Column="1" TopLine="558"/>
    513529      </Position22>
    514530      <Position23>
    515531        <Filename Value="../UMicroThreading.pas"/>
    516         <Caret Line="564" Column="1" TopLine="543"/>
     532        <Caret Line="577" Column="1" TopLine="558"/>
    517533      </Position23>
    518534      <Position24>
    519535        <Filename Value="../UMicroThreading.pas"/>
    520         <Caret Line="562" Column="1" TopLine="543"/>
     536        <Caret Line="578" Column="1" TopLine="558"/>
    521537      </Position24>
    522538      <Position25>
    523539        <Filename Value="../UMicroThreading.pas"/>
    524         <Caret Line="564" Column="1" TopLine="543"/>
     540        <Caret Line="20" Column="16" TopLine="1"/>
    525541      </Position25>
    526542      <Position26>
    527         <Filename Value="../UMicroThreading.pas"/>
    528         <Caret Line="141" Column="44" TopLine="127"/>
     543        <Filename Value="../../ExceptionLogger/UExceptionLogger.pas"/>
     544        <Caret Line="15" Column="8" TopLine="1"/>
    529545      </Position26>
    530546      <Position27>
    531547        <Filename Value="../UMicroThreading.pas"/>
    532         <Caret Line="580" Column="25" TopLine="568"/>
     548        <Caret Line="14" Column="15" TopLine="1"/>
    533549      </Position27>
    534550      <Position28>
    535         <Filename Value="../UMicroThreading.pas"/>
    536         <Caret Line="151" Column="27" TopLine="134"/>
     551        <Filename Value="Demo.lpr"/>
     552        <Caret Line="8" Column="34" TopLine="1"/>
    537553      </Position28>
    538554      <Position29>
    539555        <Filename Value="../UMicroThreading.pas"/>
    540         <Caret Line="150" Column="47" TopLine="135"/>
     556        <Caret Line="573" Column="1" TopLine="558"/>
    541557      </Position29>
    542558      <Position30>
    543559        <Filename Value="../UMicroThreading.pas"/>
    544         <Caret Line="118" Column="59" TopLine="112"/>
     560        <Caret Line="649" Column="11" TopLine="649"/>
    545561      </Position30>
    546562    </JumpHistory>
    … …  
    560576        <RangeChecks Value="True"/>
    561577        <OverflowChecks Value="True"/>
    562         <StackChecks Value="True"/>
    563578      </Checks>
    564       <VerifyObjMethodCallValidity Value="True"/>
    565579    </CodeGeneration>
    566580    <Linking>
    … …  
    582596  </CompilerOptions>
    583597  <Debugging>
    584     <BreakPoints Count="5">
     598    <BreakPoints Count="6">
    585599      <Item1>
    586600        <Source Value="../Coroutine.pas"/>
    … …  
    601615      <Item5>
    602616        <Source Value="../UMicroThreading.pas"/>
    603         <Line Value="554"/>
     617        <Line Value="560"/>
    604618      </Item5>
     619      <Item6>
     620        <Source Value="../UMicroThreading.pas"/>
     621        <Line Value="540"/>
     622      </Item6>
    605623    </BreakPoints>
    606624    <Exceptions Count="3">

  • MicroThreading/Demo/Demo.lpr

    r148 r149  
    88  {$ENDIF}{$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UMainForm, MicroThreading, ExceptionLogger
    11   { you can add units after this };
     10  Forms, UMainForm, MicroThreading;
    1211
    1312{$R *.res}

  • MicroThreading/Demo/UMainForm.lfm

    r148 r149  
    11object MainForm: TMainForm
    2   Left = 263
    3   Height = 510
    4   Top = 156
    5   Width = 798
     2  Left = 232
     3  Height = 557
     4  Top = 116
     5  Width = 863
    66  Caption = 'MicroThreading demo'
    7   ClientHeight = 510
    8   ClientWidth = 798
     7  ClientHeight = 557
     8  ClientWidth = 863
    99  OnClose = FormClose
    1010  OnCreate = FormCreate
    1111  OnDestroy = FormDestroy
     12  OnShow = FormShow
    1213  LCLVersion = '0.9.31'
    13   object ButtonSchedulerStartStop: TButton
    14     Left = 9
    15     Height = 25
    16     Top = 13
    17     Width = 103
    18     Caption = 'Start scheduler'
    19     OnClick = ButtonSchedulerStartStopClick
     14  object PageControl1: TPageControl
     15    Left = 8
     16    Height = 543
     17    Top = 8
     18    Width = 849
     19    ActivePage = TabSheet2
     20    Anchors = [akTop, akLeft, akRight, akBottom]
     21    TabIndex = 1
    2022    TabOrder = 0
     23    object TabSheet1: TTabSheet
     24      Caption = 'Job control'
     25      ClientHeight = 516
     26      ClientWidth = 845
     27      object ButtonAddWorkers: TButton
     28        Left = 10
     29        Height = 25
     30        Top = 7
     31        Width = 104
     32        Caption = 'Add workers'
     33        OnClick = ButtonAddWorkersClick
     34        TabOrder = 0
     35      end
     36      object ButtonClearMicroThreads: TButton
     37        Left = 10
     38        Height = 25
     39        Top = 37
     40        Width = 140
     41        Caption = 'Clear microthreads'
     42        OnClick = ButtonClearMicroThreadsClick
     43        TabOrder = 1
     44      end
     45      object Label4: TLabel
     46        Left = 120
     47        Height = 14
     48        Top = 14
     49        Width = 104
     50        Caption = 'Microthread count:'
     51        ParentColor = False
     52      end
     53      object SpinEdit1: TSpinEdit
     54        Left = 224
     55        Height = 21
     56        Top = 11
     57        Width = 74
     58        MaxValue = 100000
     59        MinValue = 1
     60        TabOrder = 2
     61        Value = 200
     62      end
     63      object Memo1: TMemo
     64        Left = 382
     65        Height = 267
     66        Top = 14
     67        Width = 294
     68        Anchors = [akTop, akLeft, akBottom]
     69        ScrollBars = ssAutoBoth
     70        TabOrder = 3
     71      end
     72    end
     73    object TabSheet2: TTabSheet
     74      Caption = 'Scheduler state'
     75      ClientHeight = 516
     76      ClientWidth = 845
     77      object ListView1: TListView
     78        Left = 222
     79        Height = 483
     80        Top = 24
     81        Width = 569
     82        Anchors = [akTop, akLeft, akRight, akBottom]
     83        Columns = <       
     84          item
     85            Caption = 'Id'
     86            Width = 40
     87          end       
     88          item
     89            Caption = 'Name'
     90          end       
     91          item
     92            Caption = 'Usage'
     93          end       
     94          item
     95            Caption = 'Priority'
     96          end       
     97          item
     98            Caption = 'State'
     99            Width = 60
     100          end       
     101          item
     102            Caption = 'Execution time'
     103            Width = 70
     104          end       
     105          item
     106            Caption = 'Completion'
     107          end       
     108          item
     109            Caption = 'Used stack'
     110            Width = 178
     111          end>
     112        OwnerData = True
     113        ReadOnly = True
     114        RowSelect = True
     115        TabOrder = 0
     116        ViewStyle = vsReport
     117        OnData = ListView1Data
     118      end
     119      object Label1: TLabel
     120        Left = 222
     121        Height = 14
     122        Top = 7
     123        Width = 85
     124        Caption = 'Microthread list'
     125        ParentColor = False
     126      end
     127      object GroupBox1: TGroupBox
     128        Left = 6
     129        Height = 81
     130        Top = 143
     131        Width = 205
     132        Caption = 'State'
     133        ClientHeight = 66
     134        ClientWidth = 201
     135        TabOrder = 1
     136        object Label5: TLabel
     137          Left = 9
     138          Height = 14
     139          Top = 4
     140          Width = 135
     141          Caption = 'Logical processor count:'
     142          ParentColor = False
     143        end
     144        object Label6: TLabel
     145          Left = 150
     146          Height = 14
     147          Top = 4
     148          Width = 13
     149          Caption = '    '
     150          ParentColor = False
     151        end
     152        object Label7: TLabel
     153          Left = 8
     154          Height = 14
     155          Top = 20
     156          Width = 78
     157          Caption = 'Thread count:'
     158          ParentColor = False
     159        end
     160        object Label8: TLabel
     161          Left = 9
     162          Height = 14
     163          Top = 36
     164          Width = 107
     165          Caption = 'Micro thread count:'
     166          ParentColor = False
     167        end
     168        object Label9: TLabel
     169          Left = 150
     170          Height = 14
     171          Top = 20
     172          Width = 13
     173          Caption = '    '
     174          ParentColor = False
     175        end
     176        object Label10: TLabel
     177          Left = 151
     178          Height = 14
     179          Top = 36
     180          Width = 13
     181          Caption = '    '
     182          ParentColor = False
     183        end
     184      end
     185      object GroupBox2: TGroupBox
     186        Left = 6
     187        Height = 126
     188        Top = 7
     189        Width = 206
     190        Caption = 'Control'
     191        ClientHeight = 111
     192        ClientWidth = 202
     193        TabOrder = 2
     194        object ButtonSchedulerStartStop: TButton
     195          Left = 8
     196          Height = 25
     197          Top = 7
     198          Width = 103
     199          Caption = 'Start scheduler'
     200          OnClick = ButtonSchedulerStartStopClick
     201          TabOrder = 0
     202        end
     203        object Label3: TLabel
     204          Left = 8
     205          Height = 14
     206          Top = 46
     207          Width = 78
     208          Caption = 'Thread count:'
     209          ParentColor = False
     210        end
     211        object SpinEdit2: TSpinEdit
     212          Left = 96
     213          Height = 21
     214          Top = 39
     215          Width = 74
     216          OnChange = SpinEdit2Change
     217          TabOrder = 1
     218        end
     219      end
     220    end
     221    object TabSheet3: TTabSheet
     222      Caption = 'Testing'
     223      ClientHeight = 516
     224      ClientWidth = 845
     225      object ButtonShowThreadId: TButton
     226        Left = 14
     227        Height = 25
     228        Top = 47
     229        Width = 147
     230        Caption = 'Show thread id'
     231        OnClick = ButtonShowThreadIdClick
     232        TabOrder = 0
     233      end
     234      object ButtonGetMaxThread: TButton
     235        Left = 14
     236        Height = 25
     237        Top = 79
     238        Width = 147
     239        Caption = 'Get max TThread count'
     240        OnClick = ButtonGetMaxThreadClick
     241        TabOrder = 1
     242      end
     243      object Label2: TLabel
     244        Left = 78
     245        Height = 14
     246        Top = 135
     247        Width = 38
     248        Caption = 'Label2'
     249        ParentColor = False
     250      end
     251      object Button2: TButton
     252        Left = 14
     253        Height = 25
     254        Top = 15
     255        Width = 147
     256        Caption = 'Read stack frame info'
     257        OnClick = Button2Click
     258        TabOrder = 2
     259      end
     260    end
    21261  end
    22   object ListView1: TListView
    23     Left = 310
    24     Height = 483
    25     Top = 24
    26     Width = 481
    27     Anchors = [akTop, akLeft, akRight, akBottom]
    28     Columns = <   
    29       item
    30         Caption = 'Id'
    31         Width = 40
    32       end   
    33       item
    34         Caption = 'Name'
    35       end   
    36       item
    37         Caption = 'Usage'
    38       end   
    39       item
    40         Caption = 'Priority'
    41       end   
    42       item
    43         Caption = 'State'
    44         Width = 60
    45       end   
    46       item
    47         Caption = 'Execution time'
    48         Width = 70
    49       end   
    50       item
    51         Caption = 'Completion'
    52       end>
    53     OwnerData = True
    54     ReadOnly = True
    55     RowSelect = True
    56     TabOrder = 1
    57     ViewStyle = vsReport
    58     OnData = ListView1Data
     262  object TimerRedraw: TTimer
     263    Interval = 100
     264    OnTimer = TimerRedrawTimer
     265    left = 427
     266    top = 115
    59267  end
    60   object Label1: TLabel
    61     Left = 312
    62     Height = 14
    63     Top = 8
    64     Width = 74
    65     Caption = 'Microthread list'
    66     ParentColor = False
    67   end
    68   object Memo1: TMemo
    69     Left = 10
    70     Height = 267
    71     Top = 240
    72     Width = 294
    73     Anchors = [akTop, akLeft, akBottom]
    74     ScrollBars = ssAutoBoth
    75     TabOrder = 2
    76   end
    77   object Button2: TButton
    78     Left = 224
    79     Height = 25
    80     Top = 208
    81     Width = 75
    82     Caption = 'Button2'
    83     OnClick = Button2Click
    84     TabOrder = 3
    85   end
    86   object Label2: TLabel
    87     Left = 10
    88     Height = 14
    89     Top = 192
    90     Width = 32
    91     Caption = 'Label2'
    92     ParentColor = False
    93   end
    94   object ButtonAddWorkers: TButton
    95     Left = 10
    96     Height = 25
    97     Top = 72
    98     Width = 104
    99     Caption = 'Add workers'
    100     OnClick = ButtonAddWorkersClick
    101     TabOrder = 4
    102   end
    103   object SpinEdit1: TSpinEdit
    104     Left = 224
    105     Height = 21
    106     Top = 76
    107     Width = 74
    108     MaxValue = 100000
    109     MinValue = 1
    110     TabOrder = 5
    111     Value = 200
    112   end
    113   object ButtonGetMaxThread: TButton
    114     Left = 168
    115     Height = 25
    116     Top = 160
    117     Width = 131
    118     Caption = 'Get max TThread count'
    119     OnClick = ButtonGetMaxThreadClick
    120     TabOrder = 6
    121   end
    122   object ButtonShowThreadId: TButton
    123     Left = 40
    124     Height = 25
    125     Top = 160
    126     Width = 123
    127     Caption = 'Show thread id'
    128     OnClick = ButtonShowThreadIdClick
    129     TabOrder = 7
    130   end
    131   object SpinEdit2: TSpinEdit
    132     Left = 224
    133     Height = 21
    134     Top = 13
    135     Width = 74
    136     OnChange = SpinEdit2Change
    137     TabOrder = 8
    138     Value = 1
    139   end
    140   object Label3: TLabel
    141     Left = 120
    142     Height = 14
    143     Top = 20
    144     Width = 69
    145     Caption = 'Thread count:'
    146     ParentColor = False
    147   end
    148   object Label4: TLabel
    149     Left = 120
    150     Height = 14
    151     Top = 79
    152     Width = 92
    153     Caption = 'Microthread count:'
    154     ParentColor = False
    155   end
    156   object Label5: TLabel
    157     Left = 120
    158     Height = 14
    159     Top = 40
    160     Width = 117
    161     Caption = 'Logical processor count:'
    162     ParentColor = False
    163   end
    164   object Label6: TLabel
    165     Left = 248
    166     Height = 14
    167     Top = 40
    168     Width = 13
    169     Caption = '    '
    170     ParentColor = False
    171   end
    172   object ButtonClearMicroThreads: TButton
    173     Left = 10
    174     Height = 25
    175     Top = 102
    176     Width = 104
    177     Caption = 'Clear microthreads'
    178     OnClick = ButtonClearMicroThreadsClick
    179     TabOrder = 9
    180   end
    181   object Timer1: TTimer
    182     Interval = 100
    183     OnTimer = Timer1Timer
    184     left = 399
    185     top = 87
     268  object TimerSchedulerStart: TTimer
     269    Interval = 10
     270    OnTimer = TimerSchedulerStartTimer
     271    left = 429
     272    top = 163
    186273  end
    187274end

  • MicroThreading/Demo/UMainForm.pas

    r148 r149  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ComCtrls, ExtCtrls, Spin, UMicroThreading, Coroutine, DateUtils;
     9  ComCtrls, ExtCtrls, Spin, UMicroThreading, Coroutine, DateUtils, UPlatform;
    1010
    1111type
    … …  
    1414
    1515  TMainForm = class(TForm)
    16     ButtonSchedulerStartStop: TButton;
    1716    Button2: TButton;
    1817    ButtonAddWorkers: TButton;
     18    ButtonClearMicroThreads: TButton;
    1919    ButtonGetMaxThread: TButton;
     20    ButtonSchedulerStartStop: TButton;
    2021    ButtonShowThreadId: TButton;
    21     ButtonClearMicroThreads: TButton;
     22    GroupBox1: TGroupBox;
     23    GroupBox2: TGroupBox;
    2224    Label1: TLabel;
     25    Label10: TLabel;
    2326    Label2: TLabel;
    2427    Label3: TLabel;
    … …  
    2629    Label5: TLabel;
    2730    Label6: TLabel;
     31    Label7: TLabel;
     32    Label8: TLabel;
     33    Label9: TLabel;
    2834    ListView1: TListView;
    2935    Memo1: TMemo;
     36    PageControl1: TPageControl;
    3037    SpinEdit1: TSpinEdit;
    3138    SpinEdit2: TSpinEdit;
    32     Timer1: TTimer;
     39    TabSheet1: TTabSheet;
     40    TabSheet2: TTabSheet;
     41    TabSheet3: TTabSheet;
     42    TimerRedraw: TTimer;
     43    TimerSchedulerStart: TTimer;
    3344    procedure ButtonSchedulerStartStopClick(Sender: TObject);
    3445    procedure Button2Click(Sender: TObject);
    … …  
    4051    procedure FormCreate(Sender: TObject);
    4152    procedure FormDestroy(Sender: TObject);
     53    procedure FormShow(Sender: TObject);
    4254    procedure ListView1Data(Sender: TObject; Item: TListItem);
    4355    procedure SpinEdit2Change(Sender: TObject);
    44     procedure Timer1Timer(Sender: TObject);
     56    procedure TimerRedrawTimer(Sender: TObject);
     57    procedure TimerSchedulerStartTimer(Sender: TObject);
    4558  private
    4659    procedure Worker(MicroThread: TMicroThread);
    … …  
    6578  DoubleBuffered := True;
    6679  ListView1.DoubleBuffered := True;
    67   Label6.Caption := IntToStr(Scheduler.GetCPUCoreCount);
     80  Label6.Caption := IntToStr(GetLogicalProcessorCount);
    6881end;
    6982
    … …  
    185198end;
    186199
     200procedure TMainForm.FormShow(Sender: TObject);
     201begin
     202end;
     203
    187204procedure TMainForm.ListView1Data(Sender: TObject; Item: TListItem);
    188205begin
    … …  
    198215      Item.SubItems.Add(FloatToStr(ExecutionTime));
    199216      Item.SubItems.Add(IntToStr(Trunc(Completion * 100)) + '%');
     217      Item.SubItems.Add(IntToStr(StackUsed));
    200218    end;
    201219  finally
    … …  
    209227end;
    210228
    211 procedure TMainForm.Timer1Timer(Sender: TObject);
     229procedure TMainForm.TimerRedrawTimer(Sender: TObject);
    212230begin
    213231  ListView1.Items.Count := Scheduler.MicroThreadCount;
    214232  ListView1.Items[-1];
    215233  ListView1.Refresh;
    216   Label2.Caption := DateTimeToStr(Scheduler.GetNow) + ' ' +
    217     FloatToStr(Frac(Scheduler.GetNow / OneSecond));
     234  Label2.Caption := DateTimeToStr(NowPrecise) + ' ' +
     235    FloatToStr(Frac(NowPrecise / OneSecond));
     236  Label9.Caption := IntToStr(Scheduler.ThreadPoolCount);
     237  Label10.Caption := IntToStr(Scheduler.MicroThreadCount);
     238end;
     239
     240procedure TMainForm.TimerSchedulerStartTimer(Sender: TObject);
     241begin
     242  TimerSchedulerStart.Enabled := False;
     243  ButtonAddWorkers.Click;
     244  ButtonSchedulerStartStop.Click;
    218245end;
    219246
    … …  
    226253begin
    227254  with MicroThread do begin
    228     Memo1.Lines.Add('Worker ' + IntToStr(Id));
     255    //Memo1.Lines.Add('Worker ' + IntToStr(Id));
    229256    for I := 0 to TotalSteps - 1 do begin
    230257      Q := 0;
    231       while Q < 1000000 do Inc(Q);
     258      while Q < 10000 do Inc(Q);
    232259      //Memo1.Lines.Add(IntToStr(Id) + ': ' + IntToStr(I) + ' ' +
    233260      //  FloatToStr(ExecutionTime));

  • MicroThreading/MicroThreading.lpk

    r142 r149  
    1717    <License Value="GNU/GPL"/>
    1818    <Version Minor="1"/>
    19     <Files Count="2">
     19    <Files Count="3">
    2020      <Item1>
    2121        <Filename Value="UMicroThreading.pas"/>
    … …  
    2626        <UnitName Value="Coroutine"/>
    2727      </Item2>
     28      <Item3>
     29        <Filename Value="UPlatform.pas"/>
     30        <UnitName Value="UPlatform"/>
     31      </Item3>
    2832    </Files>
    2933    <Type Value="RunAndDesignTime"/>

  • MicroThreading/MicroThreading.pas

    r140 r149  
    88
    99uses
    10   UMicroThreading, Coroutine, LazarusPackageIntf;
     10  UMicroThreading, Coroutine, UPlatform, LazarusPackageIntf;
    1111
    1212implementation

  • MicroThreading/UMicroThreading.pas

    r148 r149  
     1(* Not implemented yet
     2- Stack limit checking
     3- 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*)
     8
    19unit UMicroThreading;
    210
    … …  
    715
    816uses
    9   {$IFDEF Windows}Windows,{$ENDIF}
    10   {$IFDEF Linux}BaseUnix, UnixUtil, Unix,{$ENDIF}
    11   Classes, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms;
     17  {$IFDEF UNIX}{$IFDEF UseCThreads}
     18  cthreads,
     19  {$ENDIF}{$ENDIF}
     20  Classes, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms, UPlatform;
    1221
    1322const
    … …  
    4352    FManager: TMicroThreadManager;
    4453    FId: Integer;
     54    function GetStackUsed: Integer;
    4555  public
    4656    Name: string;
    … …  
    6979    property Scheduler: TMicroThreadScheduler read FScheduler;
    7080    property Manager: TMicroThreadManager read FManager;
     81    property StackUsed: Integer read GetStackUsed;
    7182  end;
    7283
    … …  
    8091  end;
    8192
    82   { TMicroThreadSchedulerPoolThread }
    83 
    84   TMicroThreadSchedulerPoolThread = class(TThread)
     93  { TMicroThreadThread }
     94
     95  TMicroThreadThread = class(TThread)
    8596    Manager: TMicroThreadManager;
    8697    procedure Execute; override;
    … …  
    8899      const StackSize: SizeUInt = DefaultStackSize);
    89100    destructor Destroy; override;
    90   end;
    91 
    92   TThreadPool = class(TObjectList)
    93101  end;
    94102
    … …  
    123131  private
    124132    FActive: Boolean;
    125     FThreadPool: TThreadPool;
     133    FThreadPool: TObjectList;
    126134    FThreadPoolLock: TCriticalSection;
    127135    FThreadPoolSize: Integer;
    … …  
    129137    FLastId: Integer;
    130138    FFrequency: Int64;
    131     FTerminate: Boolean;
    132139    FTerminated: Boolean;
    133140    FMicroThreads: TObjectList; // TList<TMicroThread>
    … …  
    136143    FState: TMicroThreadSchedulerState;
    137144    function GetMicroThreadCount: Integer;
     145    function GetThreadPoolCount: Integer;
    138146    function GetThreadPoolSize: Integer;
    139147    procedure SetActive(const AValue: Boolean);
    140148    procedure SetThreadPoolSize(const AValue: Integer);
    141149    function GetNextMicroThread: TMicroThread;
    142     procedure WaitFor;
    143150    procedure Start;
    144151    procedure Stop;
    145     function ThreadPoolTerminated: Boolean;
     152    procedure PoolThreadTerminated(Sender: TObject);
     153    procedure UpdateThreadPoolSize;
    146154  public
    147     function GetNow: TDateTime;
    148155    function Add(MicroThread: TMicroThread): Integer;
    149156    function AddMethod(Method: TMicroThreadEvent): Integer;
    150     function GetCPUCoreCount: Integer;
    151157    constructor Create;
    152158    destructor Destroy; override;
    153     property MicroThreadCount: Integer read GetMicroThreadCount;
     159    property ThreadPool: TObjectList read FThreadPool;
    154160    property ThreadPoolSize: Integer read GetThreadPoolSize
    155161      write SetThreadPoolSize;
     162    property ThreadPoolCount: Integer read GetThreadPoolCount;
    156163    property MicroThreads: TObjectList read FMicroThreads;
    157164    property MicroThreadsLock: TCriticalSection read FMicroThreadsLock;
     165    property MicroThreadCount: Integer read GetMicroThreadCount;
    158166    property MainThreadManager: TMicroThreadManager read FMainThreadManager;
    159167    property Active: Boolean read FActive write SetActive;
    … …  
    216224  CurrentTime: TDateTime;
    217225begin
    218   CurrentTime := FScheduler.GetNow;
     226  CurrentTime := NowPrecise;
    219227  if Assigned(FCurrentMicroThread) then begin
    220228    FCurrentMicroThread.FExecutionEndTime := CurrentTime;
    … …  
    268276        mov edx, [eax].TMicroThread.FStackPointer
    269277        mov esp, edx
    270         push ebp
     278        push ebp // remember bp on micro thread stack for read back
    271279        mov edx, [eax].TMicroThread.FBasePointer
    272280        mov ebp, edx
    … …  
    336344end;
    337345
    338 { TMicroThreadSchedulerPoolThread }
    339 
    340 procedure TMicroThreadSchedulerPoolThread.Execute;
     346{ TMicroThreadThread }
     347
     348procedure TMicroThreadThread.Execute;
    341349var
    342350  ExecutedCount: Integer;
    … …  
    354362end;
    355363
    356 constructor TMicroThreadSchedulerPoolThread.Create(CreateSuspended: Boolean;
     364constructor TMicroThreadThread.Create(CreateSuspended: Boolean;
    357365  const StackSize: SizeUInt);
    358366begin
    … …  
    361369end;
    362370
    363 destructor TMicroThreadSchedulerPoolThread.Destroy;
     371destructor TMicroThreadThread.Destroy;
    364372begin
    365373  Manager.Free;
    … …  
    377385
    378386{ TMicroThread }
     387
     388function TMicroThread.GetStackUsed: Integer;
     389begin
     390  Result := FStack + FStackSize - FStackPointer;
     391end;
    379392
    380393procedure TMicroThread.Execute;
    … …  
    398411procedure TMicroThread.Sleep(Duration: TDateTime);
    399412begin
    400   FWakeUpTime := FScheduler.GetNow + Duration;
     413  FWakeUpTime := NowPrecise + Duration;
    401414  FState := tsSleeping;
    402415  Yield;
    … …  
    461474{ TMicroThreadScheduler }
    462475
    463 function TMicroThreadScheduler.GetNow: TDateTime;
    464 var
    465   {$IFDEF Linux}T: TimeVal;{$ENDIF}
    466   {$IFDEF Windows}TimerValue: Int64;{$ENDIF}
    467 begin
    468   {$IFDEF Windows}
    469   QueryPerformanceCounter(TimerValue);
    470   //Result := Int64(TimeStampToMSecs(DateTimeToTimeStamp(Now)) * 1000) // an alternative Win32 timebase
    471   Result := TimerValue / FFrequency;
    472   {$ENDIF}
    473 
    474   {$IFDEF Linux}
    475   fpgettimeofday(@t, nil);
    476    // Build a 64 bit microsecond tick from the seconds and microsecond longints
    477   Result := t.tv_sec + t.tv_usec / 1000000;
    478   {$ENDIF}
    479 
    480   Result := (Trunc(Now / OneSecond) + Frac(Result)) * OneSecond;
    481 end;
    482 
    483476function TMicroThreadScheduler.Add(MicroThread: TMicroThread): Integer;
    484477begin
    … …  
    486479  MicroThread.FScheduler := Self;
    487480  MicroThread.FId := FLastId;
    488   Result := FMicroThreads.Add(MicroThread);
     481  try
     482    FMicroThreadsLock.Acquire;
     483    Result := FMicroThreads.Add(MicroThread);
     484  finally
     485    FMicroThreadsLock.Release;
     486  end;
    489487end;
    490488
    … …  
    499497end;
    500498
    501 function TMicroThreadScheduler.GetCPUCoreCount: Integer;
    502 var
    503   SystemInfo: _SYSTEM_INFO;
    504 begin
    505   GetSystemInfo(SystemInfo);
    506   Result := SystemInfo.dwNumberOfProcessors;
    507 end;
    508 
    509499constructor TMicroThreadScheduler.Create;
    510500begin
    … …  
    512502  FMicroThreadsLock := TCriticalSection.Create;
    513503  FMicroThreads := TObjectList.Create;
    514   FThreadPool := TThreadPool.Create;
     504  FThreadPool := TObjectList.Create;
    515505  FThreadPoolLock := TCriticalSection.Create;
    516   {$IFDEF Windows}
    517   QueryPerformanceFrequency(FFrequency);
    518   {$ENDIF}
    519506  FRoundRobinIndex := -1;
    520507  FMainThreadManager := TMicroThreadManager.Create;
    … …  
    538525begin
    539526  FTerminated := False;
    540   FTerminate := False;
    541   for I := 0 to FThreadPool.Count - 1 do
    542     TMicroThreadSchedulerPoolThread(FThreadPool[I]).Start;
     527  UpdateThreadPoolSize;
     528  FState := ssRunning;
    543529  repeat
    544530    Executed := FMainThreadManager.Execute(10);
    545531    Application.ProcessMessages;
    546532    if Executed = 0 then Sleep(1);
    547   until FTerminate;
     533  until FState <> ssRunning;
    548534  FTerminated := True;
    549535end;
    … …  
    553539  I: Integer;
    554540begin
     541  FState := ssTerminating;
    555542  try
    556543    FThreadPoolLock.Acquire;
    557544    for I := 0 to FThreadPool.Count - 1 do begin
    558       TMicroThreadSchedulerPoolThread(FThreadPool[I]).Terminate;
     545      TMicroThreadThread(FThreadPool[I]).Terminate;
    559546    end;
    560547  finally
    561548    FThreadPoolLock.Release;
    562549  end;
    563   FTerminate := True;
    564550
    565551  // Wait for all thread managers to finish
    … …  
    568554    Sleep(1);
    569555  until FTerminated and (ThreadPoolSize = 0);
    570 end;
    571 
    572 function TMicroThreadScheduler.ThreadPoolTerminated: Boolean;
    573 var
    574   I: Integer;
     556  FState := ssStopped;
     557end;
     558
     559procedure TMicroThreadScheduler.PoolThreadTerminated(Sender: TObject);
    575560begin
    576561  try
    577562    FThreadPoolLock.Acquire;
    578     I := 0;
    579     while (I < FThreadPool.Count) and
    580       (TMicroThreadSchedulerPoolThread(FThreadPool[I]).Terminated do
     563    FThreadPool.Delete(FThreadPool.IndexOf(Sender));
    581564  finally
    582565    FThreadPoolLock.Release;
    … …  
    584567end;
    585568
     569procedure TMicroThreadScheduler.UpdateThreadPoolSize;
     570var
     571  NewThread: TMicroThreadThread;
     572begin
     573  try
     574    FThreadPoolLock.Acquire;
     575    if FThreadPoolSize > FThreadPool.Count then begin
     576      FThreadPool.Capacity := FThreadPoolSize;
     577      while FThreadPool.Count < FThreadPoolSize do begin
     578        NewThread := TMicroThreadThread.Create(True);
     579        NewThread.Manager.FScheduler := Self;
     580        NewThread.OnTerminate := PoolThreadTerminated;
     581        ThreadPool.Add(NewThread);
     582        NewThread.Resume;
     583      end;
     584    end else
     585    ThreadPool.Count := FThreadPoolSize;
     586  finally
     587    FThreadPoolLock.Release;
     588  end;
     589end;
     590
    586591function TMicroThreadScheduler.GetNextMicroThread: TMicroThread;
    587592var
    … …  
    589594  CurrentTime: TDateTime;
    590595begin
    591   CurrentTime := GetNow;
     596  CurrentTime := NowPrecise;
    592597  Result := nil;
    593598  try
    … …  
    629634end;
    630635
     636function TMicroThreadScheduler.GetThreadPoolCount: Integer;
     637begin
     638  try
     639    FThreadPoolLock.Acquire;
     640    Result := FThreadPool.Count;
     641  finally
     642    FThreadPoolLock.Release;
     643  end;
     644end;
     645
    631646function TMicroThreadScheduler.GetThreadPoolSize: Integer;
    632647begin
    … …  
    645660var
    646661  I: Integer;
    647   NewThread: TMicroThreadSchedulerPoolThread;
     662  NewThread: TMicroThreadThread;
    648663begin
    649664  FThreadPoolSize := AValue;
    650665  if FState = ssRunning then
    651     SetThreadPoolCount
     666    UpdateThreadPoolSize;
    652667end;
    653668
Note: See TracChangeset for help on using the changeset viewer.