Changeset 160


Ignore:
Timestamp:
Feb 1, 2011, 10:06:01 AM (13 years ago)
Author:
george
Message:
  • Added: Unit UThreadEx which introduce class TThreadEx with support for method CurrentThread. Unit automatic mantain runtime thread list.
  • Added: Testing of exceptions raised inside microthread in demo application.
Location:
MicroThreading
Files:
1 added
8 edited

Legend:

Unmodified
Added
Removed

  • MicroThreading

    • Property svn:ignore

      •  

        old new  
        11lib
         2backup

  • MicroThreading/Demo

    • Property svn:ignore

      •  

        old new  
        22lib
        33Demo.exe
         4backup

  • MicroThreading/Demo/Demo.lpi

    r159 r160  
    3939      </Item2>
    4040    </RequiredPackages>
    41     <Units Count="69">
     41    <Units Count="79">
    4242      <Unit0>
    4343        <Filename Value="Demo.lpr"/>
    4444        <IsPartOfProject Value="True"/>
    4545        <UnitName Value="Demo"/>
    46         <EditorIndex Value="4"/>
     46        <EditorIndex Value="17"/>
    4747        <WindowIndex Value="0"/>
    4848        <TopLine Value="1"/>
    4949        <CursorPos X="34" Y="16"/>
    50         <UsageCount Value="89"/>
     50        <UsageCount Value="92"/>
    5151        <Loaded Value="True"/>
    5252      </Unit0>
    … …  
    5757        <ResourceBaseClass Value="Form"/>
    5858        <UnitName Value="UMainForm"/>
    59         <EditorIndex Value="2"/>
    60         <WindowIndex Value="0"/>
    61         <TopLine Value="100"/>
    62         <CursorPos X="45" Y="122"/>
    63         <UsageCount Value="89"/>
     59        <IsVisibleTab Value="True"/>
     60        <EditorIndex Value="9"/>
     61        <WindowIndex Value="0"/>
     62        <TopLine Value="345"/>
     63        <CursorPos X="29" Y="355"/>
     64        <UsageCount Value="92"/>
    6465        <Loaded Value="True"/>
    6566        <LoadedDesigner Value="True"/>
    … …  
    7071        <EditorIndex Value="0"/>
    7172        <WindowIndex Value="0"/>
    72         <TopLine Value="317"/>
    73         <CursorPos X="26" Y="334"/>
    74         <UsageCount Value="46"/>
     73        <TopLine Value="544"/>
     74        <CursorPos X="1" Y="557"/>
     75        <UsageCount Value="47"/>
    7576        <Loaded Value="True"/>
    7677      </Unit2>
    … …  
    113114        <CursorPos X="1" Y="8"/>
    114115        <UsageCount Value="8"/>
    115         <DefaultSyntaxHighlighter Value="Delphi"/>
    116116      </Unit7>
    117117      <Unit8>
    … …  
    122122        <CursorPos X="24" Y="77"/>
    123123        <UsageCount Value="17"/>
    124         <DefaultSyntaxHighlighter Value="Delphi"/>
    125124      </Unit8>
    126125      <Unit9>
    … …  
    131130        <CursorPos X="37" Y="141"/>
    132131        <UsageCount Value="17"/>
    133         <DefaultSyntaxHighlighter Value="Delphi"/>
    134132      </Unit9>
    135133      <Unit10>
    … …  
    251249        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/sysutils.pp"/>
    252250        <UnitName Value="sysutils"/>
    253         <WindowIndex Value="0"/>
    254         <TopLine Value="581"/>
    255         <CursorPos X="11" Y="585"/>
    256         <UsageCount Value="10"/>
     251        <EditorIndex Value="14"/>
     252        <WindowIndex Value="0"/>
     253        <TopLine Value="1034"/>
     254        <CursorPos X="14" Y="1037"/>
     255        <UsageCount Value="11"/>
     256        <Loaded Value="True"/>
    257257      </Unit26>
    258258      <Unit27>
    … …  
    308308      <Unit34>
    309309        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/wininc/func.inc"/>
    310         <WindowIndex Value="0"/>
    311         <TopLine Value="130"/>
    312         <CursorPos X="10" Y="143"/>
    313         <UsageCount Value="11"/>
     310        <EditorIndex Value="15"/>
     311        <WindowIndex Value="0"/>
     312        <TopLine Value="147"/>
     313        <CursorPos X="1" Y="158"/>
     314        <UsageCount Value="12"/>
     315        <Loaded Value="True"/>
    314316      </Unit34>
    315317      <Unit35>
    … …  
    336338      <Unit38>
    337339        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/sysutils/osutilsh.inc"/>
     340        <EditorIndex Value="13"/>
    338341        <WindowIndex Value="0"/>
    339342        <TopLine Value="14"/>
    340         <CursorPos X="17" Y="27"/>
    341         <UsageCount Value="12"/>
     343        <CursorPos X="11" Y="27"/>
     344        <UsageCount Value="13"/>
     345        <Loaded Value="True"/>
    342346      </Unit38>
    343347      <Unit39>
    … …  
    407411        <Filename Value="../UPlatform.pas"/>
    408412        <UnitName Value="UPlatform"/>
    409         <EditorIndex Value="1"/>
     413        <EditorIndex Value="8"/>
    410414        <WindowIndex Value="0"/>
    411415        <TopLine Value="23"/>
    412416        <CursorPos X="31" Y="38"/>
    413         <UsageCount Value="26"/>
     417        <UsageCount Value="27"/>
    414418        <Loaded Value="True"/>
    415419      </Unit48>
    … …  
    552556        <ResourceBaseClass Value="Form"/>
    553557        <UnitName Value="UMicroThreadList"/>
    554         <IsVisibleTab Value="True"/>
    555         <EditorIndex Value="3"/>
    556         <WindowIndex Value="0"/>
    557         <TopLine Value="1"/>
    558         <CursorPos X="29" Y="9"/>
    559         <UsageCount Value="10"/>
     558        <EditorIndex Value="16"/>
     559        <WindowIndex Value="0"/>
     560        <TopLine Value="1"/>
     561        <CursorPos X="44" Y="17"/>
     562        <UsageCount Value="11"/>
    560563        <Loaded Value="True"/>
    561564        <LoadedDesigner Value="True"/>
    … …  
    568571        <UsageCount Value="10"/>
    569572      </Unit68>
     573      <Unit69>
     574        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.5.1/fpc/2.5.1/source/rtl/objpas/sysutils/sysutilh.inc"/>
     575        <EditorIndex Value="12"/>
     576        <WindowIndex Value="0"/>
     577        <TopLine Value="100"/>
     578        <CursorPos X="16" Y="119"/>
     579        <UsageCount Value="11"/>
     580        <Loaded Value="True"/>
     581      </Unit69>
     582      <Unit70>
     583        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.5.1/lcl/interfaces/win32/win32object.inc"/>
     584        <EditorIndex Value="7"/>
     585        <WindowIndex Value="0"/>
     586        <TopLine Value="600"/>
     587        <CursorPos X="1" Y="613"/>
     588        <UsageCount Value="10"/>
     589        <Loaded Value="True"/>
     590      </Unit70>
     591      <Unit71>
     592        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.5.1/fpc/2.5.1/source/rtl/objpas/classes/classesh.inc"/>
     593        <EditorIndex Value="10"/>
     594        <WindowIndex Value="0"/>
     595        <TopLine Value="1483"/>
     596        <CursorPos X="51" Y="1490"/>
     597        <UsageCount Value="10"/>
     598        <Loaded Value="True"/>
     599      </Unit71>
     600      <Unit72>
     601        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.5.1/fpc/2.5.1/source/rtl/win/tthread.inc"/>
     602        <EditorIndex Value="11"/>
     603        <WindowIndex Value="0"/>
     604        <TopLine Value="30"/>
     605        <CursorPos X="3" Y="15"/>
     606        <UsageCount Value="10"/>
     607        <Loaded Value="True"/>
     608      </Unit72>
     609      <Unit73>
     610        <Filename Value="../UThreadEx.pas"/>
     611        <UnitName Value="UThreadEx"/>
     612        <EditorIndex Value="1"/>
     613        <WindowIndex Value="0"/>
     614        <TopLine Value="1"/>
     615        <CursorPos X="20" Y="1"/>
     616        <UsageCount Value="20"/>
     617        <Loaded Value="True"/>
     618      </Unit73>
     619      <Unit74>
     620        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.5.1/fpc/2.5.1/source/rtl/inc/systemh.inc"/>
     621        <EditorIndex Value="5"/>
     622        <WindowIndex Value="0"/>
     623        <TopLine Value="982"/>
     624        <CursorPos X="10" Y="995"/>
     625        <UsageCount Value="10"/>
     626        <Loaded Value="True"/>
     627      </Unit74>
     628      <Unit75>
     629        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.5.1/fpc/2.5.1/source/rtl/inc/system.inc"/>
     630        <EditorIndex Value="6"/>
     631        <WindowIndex Value="0"/>
     632        <TopLine Value="692"/>
     633        <CursorPos X="1" Y="694"/>
     634        <UsageCount Value="10"/>
     635        <Loaded Value="True"/>
     636      </Unit75>
     637      <Unit76>
     638        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.5.1/fpc/2.5.1/source/rtl/objpas/sysutils/osutilsh.inc"/>
     639        <EditorIndex Value="4"/>
     640        <WindowIndex Value="0"/>
     641        <TopLine Value="14"/>
     642        <CursorPos X="11" Y="27"/>
     643        <UsageCount Value="10"/>
     644        <Loaded Value="True"/>
     645      </Unit76>
     646      <Unit77>
     647        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.5.1/fpc/2.5.1/source/rtl/inc/threadh.inc"/>
     648        <EditorIndex Value="2"/>
     649        <WindowIndex Value="0"/>
     650        <TopLine Value="57"/>
     651        <CursorPos X="5" Y="70"/>
     652        <UsageCount Value="10"/>
     653        <Loaded Value="True"/>
     654      </Unit77>
     655      <Unit78>
     656        <Filename Value="../../../../Programy/Lazarus/0.9.31_2.5.1/fpc/2.5.1/source/rtl/inc/thread.inc"/>
     657        <EditorIndex Value="3"/>
     658        <WindowIndex Value="0"/>
     659        <TopLine Value="169"/>
     660        <CursorPos X="33" Y="184"/>
     661        <UsageCount Value="10"/>
     662        <Loaded Value="True"/>
     663      </Unit78>
    570664    </Units>
    571     <JumpHistory Count="21" HistoryIndex="20">
     665    <JumpHistory Count="30" HistoryIndex="29">
    572666      <Position1>
    573667        <Filename Value="UMainForm.pas"/>
    574         <Caret Line="147" Column="10" TopLine="147"/>
     668        <Caret Line="355" Column="1" TopLine="339"/>
    575669      </Position1>
    576670      <Position2>
    577         <Filename Value="UMainForm.pas"/>
    578         <Caret Line="10" Column="26" TopLine="1"/>
     671        <Filename Value="../UThreadEx.pas"/>
     672        <Caret Line="37" Column="1" TopLine="24"/>
    579673      </Position2>
    580674      <Position3>
    581         <Filename Value="UMainForm.pas"/>
    582         <Caret Line="16" Column="48" TopLine="1"/>
     675        <Filename Value="../UThreadEx.pas"/>
     676        <Caret Line="38" Column="1" TopLine="24"/>
    583677      </Position3>
    584678      <Position4>
    585         <Filename Value="../UMicroThreading.pas"/>
    586         <Caret Line="227" Column="20" TopLine="206"/>
     679        <Filename Value="../UThreadEx.pas"/>
     680        <Caret Line="39" Column="1" TopLine="24"/>
    587681      </Position4>
    588682      <Position5>
    589         <Filename Value="../UMicroThreading.pas"/>
    590         <Caret Line="21" Column="33" TopLine="1"/>
     683        <Filename Value="../UThreadEx.pas"/>
     684        <Caret Line="41" Column="1" TopLine="24"/>
    591685      </Position5>
    592686      <Position6>
    593         <Filename Value="UMainForm.pas"/>
    594         <Caret Line="90" Column="26" TopLine="85"/>
     687        <Filename Value="../UThreadEx.pas"/>
     688        <Caret Line="42" Column="1" TopLine="24"/>
    595689      </Position6>
    596690      <Position7>
    597         <Filename Value="UMainForm.pas"/>
    598         <Caret Line="5" Column="15" TopLine="1"/>
     691        <Filename Value="../UThreadEx.pas"/>
     692        <Caret Line="44" Column="1" TopLine="24"/>
    599693      </Position7>
    600694      <Position8>
    601         <Filename Value="UMainForm.pas"/>
    602         <Caret Line="150" Column="28" TopLine="147"/>
     695        <Filename Value="../UThreadEx.pas"/>
     696        <Caret Line="45" Column="1" TopLine="24"/>
    603697      </Position8>
    604698      <Position9>
    605         <Filename Value="UMainForm.pas"/>
    606         <Caret Line="85" Column="15" TopLine="72"/>
     699        <Filename Value="../UMicroThreading.pas"/>
     700        <Caret Line="130" Column="17" TopLine="117"/>
    607701      </Position9>
    608702      <Position10>
    609703        <Filename Value="UMainForm.pas"/>
    610         <Caret Line="151" Column="15" TopLine="138"/>
     704        <Caret Line="378" Column="1" TopLine="365"/>
    611705      </Position10>
    612706      <Position11>
    613         <Filename Value="UMainForm.pas"/>
    614         <Caret Line="93" Column="30" TopLine="80"/>
     707        <Filename Value="../UMicroThreading.pas"/>
     708        <Caret Line="552" Column="1" TopLine="539"/>
    615709      </Position11>
    616710      <Position12>
    617711        <Filename Value="UMainForm.pas"/>
    618         <Caret Line="123" Column="59" TopLine="110"/>
     712        <Caret Line="352" Column="1" TopLine="339"/>
    619713      </Position12>
    620714      <Position13>
    621715        <Filename Value="UMainForm.pas"/>
    622         <Caret Line="122" Column="1" TopLine="110"/>
     716        <Caret Line="353" Column="1" TopLine="339"/>
    623717      </Position13>
    624718      <Position14>
    625         <Filename Value="../UMicroThreading.pas"/>
    626         <Caret Line="217" Column="1" TopLine="197"/>
     719        <Filename Value="UMainForm.pas"/>
     720        <Caret Line="354" Column="1" TopLine="339"/>
    627721      </Position14>
    628722      <Position15>
    629         <Filename Value="../UMicroThreading.pas"/>
    630         <Caret Line="250" Column="20" TopLine="230"/>
     723        <Filename Value="UMainForm.pas"/>
     724        <Caret Line="355" Column="1" TopLine="339"/>
    631725      </Position15>
    632726      <Position16>
    633         <Filename Value="UMainForm.pas"/>
    634         <Caret Line="150" Column="16" TopLine="145"/>
     727        <Filename Value="../UThreadEx.pas"/>
     728        <Caret Line="37" Column="1" TopLine="27"/>
    635729      </Position16>
    636730      <Position17>
    637         <Filename Value="UMainForm.pas"/>
    638         <Caret Line="93" Column="25" TopLine="80"/>
     731        <Filename Value="../UThreadEx.pas"/>
     732        <Caret Line="38" Column="1" TopLine="27"/>
    639733      </Position17>
    640734      <Position18>
    641         <Filename Value="../UMicroThreading.pas"/>
    642         <Caret Line="338" Column="3" TopLine="336"/>
     735        <Filename Value="../UThreadEx.pas"/>
     736        <Caret Line="39" Column="1" TopLine="27"/>
    643737      </Position18>
    644738      <Position19>
    645         <Filename Value="UMainForm.pas"/>
    646         <Caret Line="5" Column="74" TopLine="3"/>
     739        <Filename Value="../UThreadEx.pas"/>
     740        <Caret Line="41" Column="1" TopLine="27"/>
    647741      </Position19>
    648742      <Position20>
    649         <Filename Value="../UMicroThreading.pas"/>
    650         <Caret Line="208" Column="22" TopLine="204"/>
     743        <Filename Value="../UThreadEx.pas"/>
     744        <Caret Line="42" Column="1" TopLine="27"/>
    651745      </Position20>
    652746      <Position21>
     747        <Filename Value="../UThreadEx.pas"/>
     748        <Caret Line="44" Column="1" TopLine="27"/>
     749      </Position21>
     750      <Position22>
     751        <Filename Value="../UThreadEx.pas"/>
     752        <Caret Line="1" Column="20" TopLine="1"/>
     753      </Position22>
     754      <Position23>
    653755        <Filename Value="../UMicroThreading.pas"/>
    654         <Caret Line="336" Column="36" TopLine="314"/>
    655       </Position21>
     756        <Caret Line="619" Column="24" TopLine="607"/>
     757      </Position23>
     758      <Position24>
     759        <Filename Value="../UMicroThreading.pas"/>
     760        <Caret Line="29" Column="33" TopLine="13"/>
     761      </Position24>
     762      <Position25>
     763        <Filename Value="UMainForm.pas"/>
     764        <Caret Line="378" Column="1" TopLine="365"/>
     765      </Position25>
     766      <Position26>
     767        <Filename Value="../UMicroThreading.pas"/>
     768        <Caret Line="557" Column="1" TopLine="544"/>
     769      </Position26>
     770      <Position27>
     771        <Filename Value="UMainForm.pas"/>
     772        <Caret Line="352" Column="1" TopLine="339"/>
     773      </Position27>
     774      <Position28>
     775        <Filename Value="UMainForm.pas"/>
     776        <Caret Line="353" Column="1" TopLine="339"/>
     777      </Position28>
     778      <Position29>
     779        <Filename Value="UMainForm.pas"/>
     780        <Caret Line="354" Column="1" TopLine="339"/>
     781      </Position29>
     782      <Position30>
     783        <Filename Value="UMainForm.pas"/>
     784        <Caret Line="355" Column="1" TopLine="339"/>
     785      </Position30>
    656786    </JumpHistory>
    657787  </ProjectOptions>
    … …  
    663793    <SearchPaths>
    664794      <IncludeFiles Value="$(ProjOutDir)"/>
     795      <OtherUnitFiles Value=".."/>
    665796      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
    666797    </SearchPaths>
    … …  
    692823  </CompilerOptions>
    693824  <Debugging>
    694     <BreakPoints Count="1">
     825    <BreakPoints Count="7">
    695826      <Item1>
    696827        <Source Value="../UMicroThreading.pas"/>
    697         <Line Value="250"/>
     828        <Line Value="253"/>
    698829      </Item1>
     830      <Item2>
     831        <Source Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/sysutils.pp"/>
     832        <Line Value="1036"/>
     833      </Item2>
     834      <Item3>
     835        <Source Value="../UMicroThreading.pas"/>
     836        <Line Value="591"/>
     837      </Item3>
     838      <Item4>
     839        <Source Value="../UMicroThreading.pas"/>
     840        <Line Value="590"/>
     841      </Item4>
     842      <Item5>
     843        <Source Value="UMainForm.pas"/>
     844        <Line Value="378"/>
     845      </Item5>
     846      <Item6>
     847        <Source Value="../UMicroThreading.pas"/>
     848        <Line Value="557"/>
     849      </Item6>
     850      <Item7>
     851        <Source Value="UMainForm.pas"/>
     852        <Line Value="355"/>
     853      </Item7>
    699854    </BreakPoints>
    700855    <Watches Count="2">

  • MicroThreading/Demo/UMainForm.lfm

    r159 r160  
    11object MainForm: TMainForm
    2   Left = 237
     2  Left = 282
    33  Height = 533
    4   Top = 102
     4  Top = 94
    55  Width = 816
    66  Caption = 'MicroThreading demo'
    … …  
    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
    … …  
    336336          ParentColor = False
    337337        end
     338        object Button5: TButton
     339          Left = 8
     340          Height = 25
     341          Top = 80
     342          Width = 115
     343          Caption = 'Raise exception'
     344          OnClick = Button5Click
     345          TabOrder = 6
     346        end
    338347      end
    339348    end

  • MicroThreading/Demo/UMainForm.pas

    r159 r160  
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    99  ComCtrls, ExtCtrls, Spin, UMicroThreading, DateUtils, UPlatform,
    10   UMicroThreadList;
     10  UMicroThreadList, UThreadEx;
    1111
    1212type
    … …  
    2929    Button3: TButton;
    3030    Button4: TButton;
     31    Button5: TButton;
    3132    ButtonAddWorkers: TButton;
    3233    ButtonClearMicroThreads: TButton;
    … …  
    7273    procedure Button3Click(Sender: TObject);
    7374    procedure Button4Click(Sender: TObject);
     75    procedure Button5Click(Sender: TObject);
    7476    procedure ButtonSchedulerStartStopClick(Sender: TObject);
    7577    procedure Button2Click(Sender: TObject);
    … …  
    9294  private
    9395    MicroThreadList: TMicroThreadList;
     96    LastException: Exception;
     97    LastExceptionSender: TObject;
    9498    procedure WorkerSubRoutine;
     99    procedure ShowException(Sender: TObject; E: Exception);
     100    procedure DoShowException;
    95101  public
    96102    DoWriteToMemo: Boolean;
    97103    DoSleep: Boolean;
     104    RaiseException: Boolean;
    98105    SleepDuration: Integer;
    99106    DoWaitForEvent: Boolean;
    … …  
    121128  Event := TMicroThreadEvent.Create;
    122129  MicroThreadList := TMicroThreadList.Create(Self);
     130  UMicroThreading.ExceptionHandler := ShowException;
    123131end;
    124132
    … …  
    150158begin
    151159  MicroThreadList.Form.Show;
     160end;
     161
     162procedure TMainForm.Button5Click(Sender: TObject);
     163begin
     164  RaiseException := True;
    152165end;
    153166
    … …  
    335348end;
    336349
     350procedure TMainForm.ShowException(Sender: TObject; E: Exception);
     351begin
     352  LastException := E;
     353  LastExceptionSender := Sender;
     354  if MainThreadID <> ThreadID then
     355    TThread.Synchronize(TThreadEx.CurrentThread, DoShowException)
     356    else DoShowException;
     357end;
     358
     359procedure TMainForm.DoShowException;
     360begin
     361  ShowMessage('Exception "' + LastException.Message + '" in class "' +
     362    LastExceptionSender.ClassName + '"')
     363end;
     364
    337365procedure TWorker.Execute;
    338366var
    … …  
    346374    if MainForm.DoWaitForEvent then MainForm.Event.WaitFor(MainForm.WaitForEventDuration * OneMillisecond);
    347375    if MainForm.DoSleep then MTSleep(MainForm.SleepDuration * OneMillisecond);
     376    if MainForm.RaiseException then begin
     377      MainForm.RaiseException := False;
     378      raise Exception.Create('Exception from microthread');
     379    end;
    348380    //WorkerSubRoutine;
    349381    Completion := I / MainForm.Iterations;

  • MicroThreading/MicroThreading.lpk

    r159 r160  
    1717    <License Value="GNU/GPL"/>
    1818    <Version Minor="1"/>
    19     <Files Count="4">
     19    <Files Count="5">
    2020      <Item1>
    2121        <Filename Value="UMicroThreading.pas"/>
    … …  
    3535        <UnitName Value="UMicroThreadList"/>
    3636      </Item4>
     37      <Item5>
     38        <Filename Value="UThreadEx.pas"/>
     39        <UnitName Value="UThreadEx"/>
     40      </Item5>
    3741    </Files>
    3842    <Type Value="RunAndDesignTime"/>

  • MicroThreading/MicroThreading.pas

    r159 r160  
    88
    99uses
    10   UMicroThreading, UPlatform, UMicroThreadList, LazarusPackageIntf;
     10  UMicroThreading, UPlatform, UMicroThreadList, UThreadEx, LazarusPackageIntf;
    1111
    1212implementation

  • MicroThreading/UMicroThreading.pas

    r159 r160  
    1919  {$ENDIF}{$ENDIF}
    2020  Classes, ExtCtrls, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs, Forms,
    21   UPlatform, UMicroThreadList;
     21  UPlatform, UMicroThreadList, UThreadEx;
    2222
    2323const
    24   DefaultStackSize = $40000;
     24  DefaultStackSize = $4000;
     25
     26resourcestring
     27  SStackOverflow = 'Microthread %d stack error. Pointer %s , range < %s ; %s >';
     28  SNilThreadReference = 'Can''t release nil thread.';
     29  SManagerMicroThreadRunning = 'Manager already have running microthread';
    2530
    2631type
    … …  
    124129  { TMicroThreadThread }
    125130
    126   TMicroThreadThread = class(TThread)
     131  TMicroThreadThread = class(TThreadEx)
    127132    Manager: TMicroThreadManager;
    128133    State: TMicroThreadThreadState;
    … …  
    171176    FRoundRobinIndex: Integer;
    172177    FLastId: Integer;
    173     FFrequency: Int64;
    174178    FMainThreadTerminated: Boolean;
    175179    FMicroThreads: TObjectList; // TList<TMicroThread>
    … …  
    196200    function Add(MicroThread: TMicroThread): Integer;
    197201    function AddMethod(Method: TMicroThreadMethod): Integer;
    198     function FindCurrentThread: TThread;
    199202    procedure Remove(MicroThread: TMicroThread; Free: Boolean = True);
    200203    constructor Create;
    … …  
    217220  public
    218221    Form: TMicroThreadListForm;
    219     constructor Create(AOwner: TComponent);
     222    constructor Create(AOwner: TComponent); override;
    220223  end;
    221224
    … …  
    258261function GetMicroThreadId: Integer;
    259262var
    260   I: Integer;
    261   CurrentStack: Pointer;
    262 begin
    263   asm
    264     mov CurrentStack, sp
    265   end;
    266   with MainScheduler do begin
    267     try
    268       FMicroThreadsLock.Acquire;
    269       I := 0;
    270       while (I < FMicroThreads.Count) and
    271         not ((CurrentStack >= TMicroThread(FMicroThreads[I]).FStack) and
    272         (CurrentStack <= (TMicroThread(FMicroThreads[I]).FStack +
    273         TMicroThread(FMicroThreads[I]).FStackSize))) do Inc(I);
    274       if I < FMicroThreads.Count then begin
    275         Result := TMicroThread(FMicroThreads[I]).FId;
    276       end else Result := -1;
    277     finally
    278       FMicroThreadsLock.Release;
    279     end;
    280   end;
     263  MT: TMicroThread;
     264begin
     265  MT := GetCurrentMicroThread;
     266  if Assigned(MT) then Result := MT.Id else Result := -1;
    281267end;
    282268
    283269function GetCurrentMicroThread: TMicroThread;
    284270var
    285   I: Integer;
     271  Thread: TThread;
    286272begin
    287273  with MainScheduler do
    … …  
    289275    FMicroThreadsLock.Acquire;
    290276    if MainThreadID = ThreadID then Result := MainThreadManager.CurrentMicroThread
    291       else Result := TMicroThreadThread(MainScheduler.FindCurrentThread).Manager.CurrentMicroThread;
     277      else begin
     278        Thread := TThreadEx.CurrentThread;
     279        if Assigned(Thread) then
     280          Result := TMicroThreadThread(Thread).Manager.CurrentMicroThread
     281          else Result := nil;
     282      end;
    292283  finally
    293284    FMicroThreadsLock.Release;
    … …  
    309300begin
    310301  if GetCurrentThreadId <> MainThreadID then begin
    311     Thread := MainScheduler.FindCurrentThread;
     302    Thread := TThreadEx.CurrentThread;
    312303    if Assigned(Thread) then TThread.Synchronize(Thread, Method)
    313304      else raise Exception.Create('Can''t determine thread for id ' + IntToStr(GetCurrentThreadId));
    … …  
    483474          // but virtual methods can be called only statically
    484475          // Then static method CallExecute is calling virtual method Execute
    485             call TMicroThread.CallExecute
     476          call TMicroThread.CallExecute
    486477
    487478          // Restore manager stack
    … …  
    555546  ExecutedCount: Integer;
    556547begin
    557   inherited Execute;
    558548  try
    559549    repeat
    … …  
    599589  except
    600590    on E: Exception do
    601       ExceptionHandler(Self, E);
     591      if Assigned(ExceptionHandler) then ExceptionHandler(Self, E);
    602592  end;
    603593  asm
    … …  
    632622begin
    633623  if not ((FStackPointer > FStack) and (FStackPointer < (FStack + FStackSize)))
    634     then raise EStackOverflow.Create(Format('Microthread %d stack error', [FId]));
     624    then raise EStackOverflow.Create(Format(SStackOverflow,
     625      [FId, IntToHex(Integer(FStackPointer), 8), IntToHex(Integer(FStack), 8),
     626      IntToHex(Integer(FStack + FStackSize), 8)]));
    635627end;
    636628
    … …  
    766758  NewMicroThread.FScheduler := Self;
    767759  Result := Add(NewMicroThread);
    768 end;
    769 
    770 function TMicroThreadScheduler.FindCurrentThread: TThread;
    771 var
    772   I: Integer;
    773 begin
    774   try
    775     FThreadPoolLock.Acquire;
    776     I := 0;
    777     while (I < FThreadPool.Count) and (TMicroThreadThread(FThreadPool[I]).ThreadID <> ThreadID) do Inc(I);
    778     if I < FThreadPool.Count then Result := TMicroThreadThread(FThreadPool[I])
    779       else Result := nil;
    780   finally
    781     FThreadPoolLock.Release;
    782   end;
    783760end;
    784761
    … …  
    951928    if I < FMicroThreads.Count then begin
    952929      if Assigned(Manager.FCurrentMicroThread) then
    953         raise Exception.Create('Manager have already have running microthread');
     930        raise Exception.Create(SManagerMicroThreadRunning);
    954931      Selected := TMicroThread(FMicroThreads[FRoundRobinIndex]);
    955932      Selected.FState := tsRunning;
    … …  
    965942begin
    966943  if not Assigned(MicroThread) then
    967     raise Exception.Create('Can''t release nil thread.');
     944    raise Exception.Create(SNilThreadReference);
    968945  try
    969946    FMicroThreadsLock.Acquire;
Note: See TracChangeset for help on using the changeset viewer.