Changeset 168


Ignore:
Timestamp:
Feb 10, 2011, 4:10:59 PM (14 years ago)
Author:
george
Message:
  • Added: Context menu in microthreads list to show microthread call stack.
Location:
MicroThreading
Files:
4 added
7 edited

Legend:

Unmodified
Added
Removed

  • MicroThreading/Demo/Demo.lpi

    r166 r168  
    4343      </Item3>
    4444    </RequiredPackages>
    45     <Units Count="30">
     45    <Units Count="34">
    4646      <Unit0>
    4747        <Filename Value="Demo.lpr"/>
    … …  
    5959        <ResourceBaseClass Value="Form"/>
    6060        <UnitName Value="UMainForm"/>
    61         <EditorIndex Value="9"/>
     61        <EditorIndex Value="13"/>
    6262        <WindowIndex Value="0"/>
    6363        <TopLine Value="393"/>
    … …  
    7373        <EditorIndex Value="0"/>
    7474        <WindowIndex Value="0"/>
    75         <TopLine Value="914"/>
    76         <CursorPos X="11" Y="928"/>
     75        <TopLine Value="885"/>
     76        <CursorPos X="1" Y="897"/>
    7777        <UsageCount Value="136"/>
    7878        <Loaded Value="True"/>
    … …  
    8484        <TopLine Value="1"/>
    8585        <CursorPos X="27" Y="9"/>
    86         <UsageCount Value="19"/>
     86        <UsageCount Value="18"/>
    8787      </Unit3>
    8888      <Unit4>
    … …  
    9292        <TopLine Value="1"/>
    9393        <CursorPos X="12" Y="8"/>
    94         <UsageCount Value="26"/>
     94        <UsageCount Value="25"/>
    9595      </Unit4>
    9696      <Unit5>
    … …  
    100100        <TopLine Value="1034"/>
    101101        <CursorPos X="14" Y="1037"/>
    102         <UsageCount Value="21"/>
     102        <UsageCount Value="20"/>
    103103      </Unit5>
    104104      <Unit6>
    … …  
    107107        <TopLine Value="1638"/>
    108108        <CursorPos X="28" Y="1645"/>
    109         <UsageCount Value="2"/>
     109        <UsageCount Value="1"/>
    110110      </Unit6>
    111111      <Unit7>
    … …  
    114114        <TopLine Value="147"/>
    115115        <CursorPos X="1" Y="158"/>
    116         <UsageCount Value="22"/>
     116        <UsageCount Value="21"/>
    117117      </Unit7>
    118118      <Unit8>
    … …  
    121121        <TopLine Value="14"/>
    122122        <CursorPos X="11" Y="27"/>
    123         <UsageCount Value="23"/>
     123        <UsageCount Value="22"/>
    124124      </Unit8>
    125125      <Unit9>
    … …  
    130130        <TopLine Value="25"/>
    131131        <CursorPos X="41" Y="39"/>
    132         <UsageCount Value="38"/>
     132        <UsageCount Value="42"/>
    133133        <Loaded Value="True"/>
    134134      </Unit9>
    … …  
    140140        <EditorIndex Value="7"/>
    141141        <WindowIndex Value="0"/>
    142         <TopLine Value="53"/>
    143         <CursorPos X="61" Y="61"/>
    144         <UsageCount Value="24"/>
     142        <TopLine Value="121"/>
     143        <CursorPos X="10" Y="138"/>
     144        <UsageCount Value="28"/>
    145145        <Loaded Value="True"/>
    146146        <LoadedDesigner Value="True"/>
    … …  
    151151        <TopLine Value="191"/>
    152152        <CursorPos X="13" Y="204"/>
    153         <UsageCount Value="21"/>
     153        <UsageCount Value="20"/>
    154154      </Unit11>
    155155      <Unit12>
    … …  
    158158        <TopLine Value="600"/>
    159159        <CursorPos X="1" Y="613"/>
    160         <UsageCount Value="20"/>
     160        <UsageCount Value="19"/>
    161161      </Unit12>
    162162      <Unit13>
    … …  
    165165        <TopLine Value="1483"/>
    166166        <CursorPos X="51" Y="1490"/>
    167         <UsageCount Value="20"/>
     167        <UsageCount Value="19"/>
    168168      </Unit13>
    169169      <Unit14>
    … …  
    172172        <TopLine Value="30"/>
    173173        <CursorPos X="3" Y="15"/>
    174         <UsageCount Value="20"/>
     174        <UsageCount Value="19"/>
    175175      </Unit14>
    176176      <Unit15>
    … …  
    180180        <TopLine Value="1"/>
    181181        <CursorPos X="20" Y="1"/>
    182         <UsageCount Value="30"/>
     182        <UsageCount Value="29"/>
    183183      </Unit15>
    184184      <Unit16>
    … …  
    187187        <TopLine Value="469"/>
    188188        <CursorPos X="18" Y="484"/>
    189         <UsageCount Value="20"/>
     189        <UsageCount Value="19"/>
    190190      </Unit16>
    191191      <Unit17>
    … …  
    194194        <TopLine Value="920"/>
    195195        <CursorPos X="17" Y="942"/>
    196         <UsageCount Value="20"/>
     196        <UsageCount Value="19"/>
    197197      </Unit17>
    198198      <Unit18>
    … …  
    201201        <TopLine Value="14"/>
    202202        <CursorPos X="11" Y="27"/>
    203         <UsageCount Value="20"/>
     203        <UsageCount Value="19"/>
    204204      </Unit18>
    205205      <Unit19>
    … …  
    208208        <TopLine Value="57"/>
    209209        <CursorPos X="5" Y="70"/>
    210         <UsageCount Value="20"/>
     210        <UsageCount Value="19"/>
    211211      </Unit19>
    212212      <Unit20>
    … …  
    215215        <TopLine Value="169"/>
    216216        <CursorPos X="33" Y="184"/>
    217         <UsageCount Value="20"/>
     217        <UsageCount Value="19"/>
    218218      </Unit20>
    219219      <Unit21>
    … …  
    222222        <TopLine Value="429"/>
    223223        <CursorPos X="19" Y="435"/>
    224         <UsageCount Value="19"/>
     224        <UsageCount Value="18"/>
    225225      </Unit21>
    226226      <Unit22>
    … …  
    229229        <TopLine Value="329"/>
    230230        <CursorPos X="14" Y="342"/>
    231         <UsageCount Value="19"/>
     231        <UsageCount Value="18"/>
    232232      </Unit22>
    233233      <Unit23>
    … …  
    236236        <TopLine Value="29"/>
    237237        <CursorPos X="23" Y="42"/>
    238         <UsageCount Value="16"/>
     238        <UsageCount Value="15"/>
    239239      </Unit23>
    240240      <Unit24>
    241241        <Filename Value="../../../../Projekty2/FreePascalManager/trunk/Instance/1/FPC/packages/fcl-base/src/syncobjs.pp"/>
    242242        <UnitName Value="syncobjs"/>
    243         <EditorIndex Value="8"/>
     243        <EditorIndex Value="12"/>
    244244        <WindowIndex Value="0"/>
    245245        <TopLine Value="35"/>
    246246        <CursorPos X="18" Y="45"/>
    247         <UsageCount Value="13"/>
     247        <UsageCount Value="17"/>
    248248        <Loaded Value="True"/>
    249249      </Unit24>
    … …  
    254254        <TopLine Value="548"/>
    255255        <CursorPos X="1" Y="561"/>
    256         <UsageCount Value="12"/>
     256        <UsageCount Value="16"/>
    257257        <Loaded Value="True"/>
    258258      </Unit25>
    … …  
    263263        <TopLine Value="798"/>
    264264        <CursorPos X="1" Y="821"/>
    265         <UsageCount Value="12"/>
     265        <UsageCount Value="16"/>
    266266        <Loaded Value="True"/>
    267267      </Unit26>
    … …  
    272272        <TopLine Value="65"/>
    273273        <CursorPos X="29" Y="75"/>
    274         <UsageCount Value="12"/>
     274        <UsageCount Value="16"/>
    275275        <Loaded Value="True"/>
    276276      </Unit27>
    … …  
    282282        <TopLine Value="1398"/>
    283283        <CursorPos X="15" Y="1309"/>
    284         <UsageCount Value="11"/>
     284        <UsageCount Value="15"/>
    285285        <Loaded Value="True"/>
    286286      </Unit28>
    … …  
    291291        <TopLine Value="2161"/>
    292292        <CursorPos X="33" Y="2161"/>
     293        <UsageCount Value="15"/>
     294        <Loaded Value="True"/>
     295      </Unit29>
     296      <Unit30>
     297        <Filename Value="../UMicroThreadCallStack.pas"/>
     298        <ComponentName Value="CallStackForm"/>
     299        <ResourceBaseClass Value="Form"/>
     300        <UnitName Value="UMicroThreadCallStack"/>
     301        <EditorIndex Value="8"/>
     302        <WindowIndex Value="0"/>
     303        <TopLine Value="44"/>
     304        <CursorPos X="22" Y="66"/>
     305        <UsageCount Value="14"/>
     306        <Loaded Value="True"/>
     307        <LoadedDesigner Value="True"/>
     308      </Unit30>
     309      <Unit31>
     310        <Filename Value="../UStackTrace.pas"/>
     311        <UnitName Value="UStackTrace"/>
     312        <EditorIndex Value="9"/>
     313        <WindowIndex Value="0"/>
     314        <TopLine Value="17"/>
     315        <CursorPos X="26" Y="122"/>
    293316        <UsageCount Value="11"/>
    294317        <Loaded Value="True"/>
    295       </Unit29>
     318      </Unit31>
     319      <Unit32>
     320        <Filename Value="../../../../Projekty2/FreePascalManager/trunk/Instance/1/FPC/rtl/inc/systemh.inc"/>
     321        <EditorIndex Value="10"/>
     322        <WindowIndex Value="0"/>
     323        <TopLine Value="974"/>
     324        <CursorPos X="10" Y="987"/>
     325        <UsageCount Value="11"/>
     326        <Loaded Value="True"/>
     327      </Unit32>
     328      <Unit33>
     329        <Filename Value="../../../../Projekty2/FreePascalManager/trunk/Instance/1/FPC/rtl/i386/i386.inc"/>
     330        <EditorIndex Value="11"/>
     331        <WindowIndex Value="0"/>
     332        <TopLine Value="1135"/>
     333        <CursorPos X="10" Y="1139"/>
     334        <UsageCount Value="11"/>
     335        <Loaded Value="True"/>
     336      </Unit33>
    296337    </Units>
    297338    <JumpHistory Count="30" HistoryIndex="29">
    298339      <Position1>
    299         <Filename Value="../UMicroThreading.pas"/>
    300         <Caret Line="939" Column="1" TopLine="932"/>
     340        <Filename Value="../UStackTrace.pas"/>
     341        <Caret Line="76" Column="60" TopLine="63"/>
    301342      </Position1>
    302343      <Position2>
    303         <Filename Value="../UMicroThreading.pas"/>
    304         <Caret Line="940" Column="1" TopLine="932"/>
     344        <Filename Value="../UStackTrace.pas"/>
     345        <Caret Line="74" Column="17" TopLine="63"/>
    305346      </Position2>
    306347      <Position3>
    307         <Filename Value="../UMicroThreading.pas"/>
    308         <Caret Line="941" Column="1" TopLine="932"/>
     348        <Filename Value="../UStackTrace.pas"/>
     349        <Caret Line="63" Column="27" TopLine="49"/>
    309350      </Position3>
    310351      <Position4>
    311         <Filename Value="../UMicroThreading.pas"/>
    312         <Caret Line="942" Column="1" TopLine="932"/>
     352        <Filename Value="../UStackTrace.pas"/>
     353        <Caret Line="79" Column="32" TopLine="64"/>
    313354      </Position4>
    314355      <Position5>
    315         <Filename Value="../UMicroThreading.pas"/>
    316         <Caret Line="944" Column="1" TopLine="932"/>
     356        <Filename Value="../UStackTrace.pas"/>
     357        <Caret Line="76" Column="66" TopLine="61"/>
    317358      </Position5>
    318359      <Position6>
    319         <Filename Value="../UMicroThreading.pas"/>
    320         <Caret Line="946" Column="1" TopLine="932"/>
     360        <Filename Value="../UStackTrace.pas"/>
     361        <Caret Line="74" Column="1" TopLine="61"/>
    321362      </Position6>
    322363      <Position7>
    323         <Filename Value="../UMicroThreading.pas"/>
    324         <Caret Line="937" Column="1" TopLine="932"/>
     364        <Filename Value="../UStackTrace.pas"/>
     365        <Caret Line="75" Column="1" TopLine="61"/>
    325366      </Position7>
    326367      <Position8>
    327         <Filename Value="../UMicroThreading.pas"/>
    328         <Caret Line="938" Column="1" TopLine="932"/>
     368        <Filename Value="../UStackTrace.pas"/>
     369        <Caret Line="76" Column="1" TopLine="61"/>
    329370      </Position8>
    330371      <Position9>
    331         <Filename Value="../UMicroThreading.pas"/>
    332         <Caret Line="846" Column="1" TopLine="833"/>
     372        <Filename Value="../UStackTrace.pas"/>
     373        <Caret Line="74" Column="1" TopLine="61"/>
    333374      </Position9>
    334375      <Position10>
    335         <Filename Value="../UMicroThreading.pas"/>
    336         <Caret Line="859" Column="1" TopLine="837"/>
     376        <Filename Value="../UStackTrace.pas"/>
     377        <Caret Line="75" Column="1" TopLine="61"/>
    337378      </Position10>
    338379      <Position11>
    339380        <Filename Value="../UMicroThreading.pas"/>
    340         <Caret Line="847" Column="1" TopLine="837"/>
     381        <Caret Line="854" Column="3" TopLine="847"/>
    341382      </Position11>
    342383      <Position12>
    343384        <Filename Value="../UMicroThreading.pas"/>
    344         <Caret Line="848" Column="1" TopLine="837"/>
     385        <Caret Line="853" Column="41" TopLine="847"/>
    345386      </Position12>
    346387      <Position13>
    347388        <Filename Value="../UMicroThreading.pas"/>
    348         <Caret Line="849" Column="1" TopLine="837"/>
     389        <Caret Line="854" Column="1" TopLine="847"/>
    349390      </Position13>
    350391      <Position14>
    351392        <Filename Value="../UMicroThreading.pas"/>
    352         <Caret Line="850" Column="1" TopLine="837"/>
     393        <Caret Line="855" Column="1" TopLine="847"/>
    353394      </Position14>
    354395      <Position15>
    355         <Filename Value="../UMicroThreading.pas"/>
    356         <Caret Line="851" Column="1" TopLine="837"/>
     396        <Filename Value="../UStackTrace.pas"/>
     397        <Caret Line="74" Column="1" TopLine="61"/>
    357398      </Position15>
    358399      <Position16>
    359         <Filename Value="../UMicroThreading.pas"/>
    360         <Caret Line="852" Column="1" TopLine="837"/>
     400        <Filename Value="../UStackTrace.pas"/>
     401        <Caret Line="75" Column="1" TopLine="61"/>
    361402      </Position16>
    362403      <Position17>
    363         <Filename Value="../UMicroThreading.pas"/>
    364         <Caret Line="853" Column="1" TopLine="837"/>
     404        <Filename Value="../UStackTrace.pas"/>
     405        <Caret Line="76" Column="1" TopLine="61"/>
    365406      </Position17>
    366407      <Position18>
    367         <Filename Value="../UMicroThreading.pas"/>
    368         <Caret Line="854" Column="1" TopLine="837"/>
     408        <Filename Value="../UStackTrace.pas"/>
     409        <Caret Line="74" Column="1" TopLine="61"/>
    369410      </Position18>
    370411      <Position19>
    371         <Filename Value="../UMicroThreading.pas"/>
    372         <Caret Line="857" Column="1" TopLine="837"/>
     412        <Filename Value="../UStackTrace.pas"/>
     413        <Caret Line="75" Column="50" TopLine="61"/>
    373414      </Position19>
    374415      <Position20>
    375         <Filename Value="../UMicroThreading.pas"/>
    376         <Caret Line="858" Column="1" TopLine="837"/>
     416        <Filename Value="../UStackTrace.pas"/>
     417        <Caret Line="74" Column="45" TopLine="61"/>
    377418      </Position20>
    378419      <Position21>
    379         <Filename Value="../UMicroThreading.pas"/>
    380         <Caret Line="859" Column="1" TopLine="837"/>
     420        <Filename Value="../UStackTrace.pas"/>
     421        <Caret Line="73" Column="29" TopLine="61"/>
    381422      </Position21>
    382423      <Position22>
    383         <Filename Value="../UMicroThreading.pas"/>
    384         <Caret Line="939" Column="1" TopLine="926"/>
     424        <Filename Value="../UStackTrace.pas"/>
     425        <Caret Line="76" Column="1" TopLine="61"/>
    385426      </Position22>
    386427      <Position23>
    387         <Filename Value="../UMicroThreading.pas"/>
    388         <Caret Line="940" Column="1" TopLine="926"/>
     428        <Filename Value="../UStackTrace.pas"/>
     429        <Caret Line="91" Column="1" TopLine="78"/>
    389430      </Position23>
    390431      <Position24>
    391         <Filename Value="../UMicroThreading.pas"/>
    392         <Caret Line="941" Column="1" TopLine="926"/>
     432        <Filename Value="../UMicroThreadCallStack.pas"/>
     433        <Caret Line="67" Column="38" TopLine="46"/>
    393434      </Position24>
    394435      <Position25>
    395         <Filename Value="../UMicroThreading.pas"/>
    396         <Caret Line="942" Column="1" TopLine="926"/>
     436        <Filename Value="../UStackTrace.pas"/>
     437        <Caret Line="76" Column="1" TopLine="63"/>
    397438      </Position25>
    398439      <Position26>
    399         <Filename Value="../UMicroThreading.pas"/>
    400         <Caret Line="938" Column="45" TopLine="926"/>
     440        <Filename Value="../UStackTrace.pas"/>
     441        <Caret Line="78" Column="1" TopLine="63"/>
    401442      </Position26>
    402443      <Position27>
    403         <Filename Value="../UMicroThreading.pas"/>
    404         <Caret Line="940" Column="1" TopLine="914"/>
     444        <Filename Value="../UMicroThreadCallStack.pas"/>
     445        <Caret Line="66" Column="19" TopLine="47"/>
    405446      </Position27>
    406447      <Position28>
    407         <Filename Value="../UMicroThreading.pas"/>
    408         <Caret Line="901" Column="32" TopLine="888"/>
     448        <Filename Value="../UMicroThreadCallStack.pas"/>
     449        <Caret Line="67" Column="14" TopLine="47"/>
    409450      </Position28>
    410451      <Position29>
    411         <Filename Value="../UMicroThreading.pas"/>
    412         <Caret Line="236" Column="43" TopLine="236"/>
     452        <Filename Value="../UMicroThreadCallStack.pas"/>
     453        <Caret Line="66" Column="22" TopLine="44"/>
    413454      </Position29>
    414455      <Position30>
    415         <Filename Value="../UMicroThreading.pas"/>
    416         <Caret Line="926" Column="22" TopLine="913"/>
     456        <Filename Value="../UMicroThreadList.pas"/>
     457        <Caret Line="138" Column="10" TopLine="121"/>
    417458      </Position30>
    418459    </JumpHistory>

  • MicroThreading/Demo/UMainForm.lfm

    r166 r168  
    11object MainForm: TMainForm
    2   Left = 282
     2  Left = 0
    33  Height = 533
    4   Top = 94
    5   Width = 816
     4  Top = 13
     5  Width = 792
    66  Caption = 'MicroThreading demo'
    77  ClientHeight = 514
    8   ClientWidth = 816
     8  ClientWidth = 792
    99  Menu = MainMenu1
    1010  OnCreate = FormCreate
    … …  
    1616    Height = 500
    1717    Top = 8
    18     Width = 802
     18    Width = 778
    1919    ActivePage = TabSheet1
    2020    Anchors = [akTop, akLeft, akRight, akBottom]
    … …  
    108108      Caption = 'Job control'
    109109      ClientHeight = 474
    110       ClientWidth = 794
     110      ClientWidth = 770
    111111      object ButtonAddWorkers: TButton
    112112        Left = 10

  • MicroThreading/MicroThreading.lpk

    r162 r168  
    1616    <Description Value="Micro threading subsystem. "/>
    1717    <License Value="GNU/GPL"/>
    18     <Version Minor="1"/>
    19     <Files Count="5">
     18    <Version Minor="2"/>
     19    <Files Count="6">
    2020      <Item1>
    2121        <Filename Value="UMicroThreading.pas"/>
    … …  
    3939        <UnitName Value="UThreadEx"/>
    4040      </Item5>
     41      <Item6>
     42        <Filename Value="UMicroThreadCallStack.pas"/>
     43        <UnitName Value="UMicroThreadCallStack"/>
     44      </Item6>
    4145    </Files>
    4246    <Type Value="RunAndDesignTime"/>
    4347    <RequiredPkgs Count="4">
    4448      <Item1>
    45         <PackageName Value="LCLBase"/>
     49        <PackageName Value="ExceptionLogger"/>
    4650      </Item1>
    4751      <Item2>

  • MicroThreading/MicroThreading.pas

    r160 r168  
    88
    99uses
    10   UMicroThreading, UPlatform, UMicroThreadList, UThreadEx, LazarusPackageIntf;
     10  UMicroThreading, UPlatform, UMicroThreadList, UThreadEx,
     11  UMicroThreadCallStack, LazarusPackageIntf;
    1112
    1213implementation

  • MicroThreading/UMicroThreadList.lfm

    r164 r168  
    11object MicroThreadListForm: TMicroThreadListForm
    2   Left = 476
     2  Left = 321
    33  Height = 423
    4   Top = 111
     4  Top = 108
    55  Width = 569
    66  Caption = 'Microthread list'
    … …  
    88  ClientWidth = 569
    99  OnClose = FormClose
     10  OnCreate = FormCreate
     11  OnDestroy = FormDestroy
    1012  OnHide = FormHide
    1113  OnShow = FormShow
    … …  
    1618    Top = 7
    1719    Width = 553
    18     ActivePage = TabSheet1
     20    ActivePage = TabSheet3
    1921    Anchors = [akTop, akLeft, akRight, akBottom]
    20     TabIndex = 0
     22    TabIndex = 2
    2123    TabOrder = 0
    2224    object TabSheet1: TTabSheet
    … …  
    170172          end>
    171173        OwnerData = True
     174        PopupMenu = PopupMenu1
    172175        ReadOnly = True
    173176        RowSelect = True
    … …  
    185188    top = 85
    186189  end
     190  object PopupMenu1: TPopupMenu
     191    left = 192
     192    top = 136
     193    object MenuItemCallStack: TMenuItem
     194      Caption = 'Call stack'
     195      OnClick = MenuItemCallStackClick
     196    end
     197  end
    187198end

  • MicroThreading/UMicroThreadList.pas

    r164 r168  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    9   ExtCtrls, StdCtrls, DateUtils, UPlatform;
     9  ExtCtrls, StdCtrls, Menus, DateUtils, UPlatform, UMicroThreadCallStack;
    1010
    1111type
    … …  
    2121    Label8: TLabel;
    2222    Label9: TLabel;
     23    MenuItemCallStack: TMenuItem;
     24    PopupMenu1: TPopupMenu;
    2325    TimerRedraw: TTimer;
    2426    Label1: TLabel;
    … …  
    3133    TabSheet3: TTabSheet;
    3234    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     35    procedure FormCreate(Sender: TObject);
     36    procedure FormDestroy(Sender: TObject);
    3337    procedure FormHide(Sender: TObject);
    3438    procedure FormShow(Sender: TObject);
    3539    procedure ListView1Data(Sender: TObject; Item: TListItem);
    3640    procedure ListView2Data(Sender: TObject; Item: TListItem);
     41    procedure MenuItemCallStackClick(Sender: TObject);
    3742    procedure TimerRedrawTimer(Sender: TObject);
    3843  private
    39     { private declarations }
     44    CallStackForm: TCallStackForm;
    4045  public
    4146    { public declarations }
    … …  
    8186    with TMicroThread(MainScheduler.MicroThreads[Item.Index]) do begin
    8287      Item.Caption := IntToStr(Id);
     88      Item.Data := TMicroThread(MainScheduler.MicroThreads[Item.Index]);
    8389      Item.SubItems.Add('');
    8490      Item.SubItems.Add(IntToStr(Priority));
    … …  
    124130end;
    125131
     132procedure TMicroThreadListForm.MenuItemCallStackClick(Sender: TObject);
     133begin
     134  if Assigned(ListView1.Selected) then
     135  with TMicroThread(ListView1.Selected.Data) do begin
     136    //Suspend;
     137    CallStackForm.Show(BasePointer);
     138    //Resume;
     139  end;
     140end;
     141
    126142procedure TMicroThreadListForm.FormShow(Sender: TObject);
    127143begin
    … …  
    140156end;
    141157
     158procedure TMicroThreadListForm.FormCreate(Sender: TObject);
     159begin
     160  CallStackForm := TCallStackForm.Create(nil);
     161end;
     162
     163procedure TMicroThreadListForm.FormDestroy(Sender: TObject);
     164begin
     165  CallStackForm.Free;
     166end;
     167
    142168
    143169end.

  • MicroThreading/UMicroThreading.pas

    r166 r168  
    141141    property Manager: TMicroThreadManager read FManager write SetManager;
    142142    property StackUsed: Integer read GetStackUsed;
     143    property BasePointer: Pointer read FBasePointer;
    143144  end;
    144145
    … …  
    391392    Dec(FCounter);
    392393    if FMicroThreads.Count > 0 then begin
    393       // Release one waiting micro thread and lower counter
     394      // Release one waiting micro thread
    394395      TMicroThread(FMicroThreads[0]).FState := tsWaiting;
    395396      FMicroThreads.Delete(0);
    … …  
    435436  Form := TMicroThreadListForm.Create(Self);
    436437end;
    437 
    438 
    439438
    440439{ TMicroThreadMethod }
    … …  
    797796begin
    798797  try
     798    FScheduler.FMicroThreadsLock.Acquire;
    799799    CriticalSection.Lock.Acquire;
    800800    Inc(CriticalSection.FCounter);
    … …  
    805805      try
    806806        CriticalSection.Lock.Release;
     807        FScheduler.FMicroThreadsLock.Release;
    807808        Yield;
    808809      finally
     810        FScheduler.FMicroThreadsLock.Acquire;
    809811        CriticalSection.Lock.Acquire;
    810812      end;
    … …  
    812814  finally
    813815    CriticalSection.Lock.Release;
     816    FScheduler.FMicroThreadsLock.Release;
    814817  end;
    815818end;
    … …  
    845848  const StackSize: SizeUInt = DefaultStackSize);
    846849begin
     850  // Setup stack
    847851  FStackSize := StackSize;
    848852  FStack := GetMem(FStackSize);
    849   FBasePointer := FStack + FStackSize;
     853  FBasePointer := FStack + FStackSize - SizeOf(Pointer);
    850854  FStackPointer := FBasePointer - SizeOf(Pointer);
     855  FillChar(FStackPointer^, 2 * SizeOf(Pointer), 0);
     856
    851857  FExecutionTime := 0;
    852858  FState := tsWaiting;
    … …  
    886892
    887893procedure TMicroThread.Suspend;
     894var
     895  MT: TMicroThread;
    888896begin
    889897  FStatePending := tsSuspended;
    890   //Yield;
     898  MT := GetCurrentMicroThread;
     899  if Assigned(MT) then Yield;
    891900end;
    892901
    … …  
    918927begin
    919928  try
    920     NewMicroThread := TMicroThreadSimple.Create(False);
     929    NewMicroThread := TMicroThreadSimple.Create(True);
    921930    NewMicroThread.Method := Method;
    922931    NewMicroThread.FScheduler := Self;
    923932    NewMicroThread.FreeOnTerminate := not WaitForFinish;
     933    NewMicroThread.Start;
    924934    if WaitForFinish then begin
    925935      CurrentMT := GetCurrentMicroThread;
    926       while not ((NewMicroThread.FState = tsBlocked) and
    927       (NewMicroThread.FBlockState = tbsTerminated)) do begin
    928         try
    929           FMicroThreadsLock.Release;
    930           if Assigned(CurrentMT) then CurrentMT.MTSleep(1 * OneMillisecond)
    931           else begin
    932             Sleep(1);
    933             Application.ProcessMessages;
     936      try
     937        FMicroThreadsLock.Acquire;
     938        while not ((NewMicroThread.FState = tsBlocked) and
     939        (NewMicroThread.FBlockState = tbsTerminated)) do begin
     940          try
     941            FMicroThreadsLock.Release;
     942            if Assigned(CurrentMT) then CurrentMT.MTSleep(1 * OneMillisecond)
     943            else begin
     944              Sleep(1);
     945              Application.ProcessMessages;
     946            end;
     947          finally
     948            FMicroThreadsLock.Acquire;
    934949          end;
    935         finally
    936           FMicroThreadsLock.Acquire;
    937950        end;
     951      finally
     952        FMicroThreadsLock.Release;
    938953      end;
    939954    end;
Note: See TracChangeset for help on using the changeset viewer.