1 | unit UMicroThreadList;
|
---|
2 |
|
---|
3 | {$mode objfpc}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
|
---|
9 | ExtCtrls, StdCtrls, Menus, DateUtils, UPlatform, UMicroThreadCallStack;
|
---|
10 |
|
---|
11 | type
|
---|
12 |
|
---|
13 | { TMicroThreadListForm }
|
---|
14 |
|
---|
15 | TMicroThreadListForm = class(TForm)
|
---|
16 | published
|
---|
17 | Label10: TLabel;
|
---|
18 | Label5: TLabel;
|
---|
19 | Label6: TLabel;
|
---|
20 | Label7: TLabel;
|
---|
21 | Label8: TLabel;
|
---|
22 | Label9: TLabel;
|
---|
23 | MenuItemCallStack: TMenuItem;
|
---|
24 | PopupMenu1: TPopupMenu;
|
---|
25 | TimerRedraw: TTimer;
|
---|
26 | Label1: TLabel;
|
---|
27 | Label2: TLabel;
|
---|
28 | ListView1: TListView;
|
---|
29 | ListView2: TListView;
|
---|
30 | PageControl1: TPageControl;
|
---|
31 | TabSheet1: TTabSheet;
|
---|
32 | TabSheet2: TTabSheet;
|
---|
33 | TabSheet3: TTabSheet;
|
---|
34 | procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
---|
35 | procedure FormCreate(Sender: TObject);
|
---|
36 | procedure FormDestroy(Sender: TObject);
|
---|
37 | procedure FormHide(Sender: TObject);
|
---|
38 | procedure FormShow(Sender: TObject);
|
---|
39 | procedure ListView1Data(Sender: TObject; Item: TListItem);
|
---|
40 | procedure ListView2Data(Sender: TObject; Item: TListItem);
|
---|
41 | procedure MenuItemCallStackClick(Sender: TObject);
|
---|
42 | procedure TimerRedrawTimer(Sender: TObject);
|
---|
43 | private
|
---|
44 | CallStackForm: TCallStackForm;
|
---|
45 | public
|
---|
46 | { public declarations }
|
---|
47 | end;
|
---|
48 |
|
---|
49 | implementation
|
---|
50 |
|
---|
51 | {$R *.lfm}
|
---|
52 |
|
---|
53 | uses
|
---|
54 | UMicroThreading;
|
---|
55 |
|
---|
56 | { TMicroThreadListForm }
|
---|
57 |
|
---|
58 | procedure TMicroThreadListForm.TimerRedrawTimer(Sender: TObject);
|
---|
59 | var
|
---|
60 | ThreadCount: Integer;
|
---|
61 | begin
|
---|
62 | if ListView1.Items.Count <> MainScheduler.MicroThreadCount then
|
---|
63 | ListView1.Items.Count := MainScheduler.MicroThreadCount;
|
---|
64 | ListView1.Items[-1];
|
---|
65 | ListView1.Refresh;
|
---|
66 |
|
---|
67 | ThreadCount := MainScheduler.ThreadPoolCount;
|
---|
68 | if MainScheduler.UseMainThread then Inc(ThreadCount);
|
---|
69 | if ListView2.Items.Count <> ThreadCount then
|
---|
70 | ListView2.Items.Count := ThreadCount;
|
---|
71 | ListView2.Items[-1];
|
---|
72 | ListView2.Refresh;
|
---|
73 |
|
---|
74 | Label6.Caption := IntToStr(GetLogicalProcessorCount);
|
---|
75 | Label9.Caption := IntToStr(MainScheduler.ThreadPoolCount);
|
---|
76 | Label10.Caption := IntToStr(MainScheduler.MicroThreadCount);
|
---|
77 | Label2.Caption := FloatToStr(MainScheduler.MainThreadOutsideDuration / OneMillisecond) + ' ms';
|
---|
78 | end;
|
---|
79 |
|
---|
80 | procedure TMicroThreadListForm.ListView1Data(Sender: TObject; Item: TListItem
|
---|
81 | );
|
---|
82 | begin
|
---|
83 | try
|
---|
84 | MainScheduler.MicroThreadsLock.Acquire;
|
---|
85 | if Item.Index < MainScheduler.MicroThreads.Count then
|
---|
86 | with TMicroThread(MainScheduler.MicroThreads[Item.Index]) do begin
|
---|
87 | Item.Caption := IntToStr(Id);
|
---|
88 | Item.Data := TMicroThread(MainScheduler.MicroThreads[Item.Index]);
|
---|
89 | Item.SubItems.Add('');
|
---|
90 | Item.SubItems.Add(IntToStr(Priority));
|
---|
91 | Item.SubItems.Add(MicroThreadStateText[State]);
|
---|
92 | Item.SubItems.Add(MicroThreadBlockStateText[BlockState]);
|
---|
93 | Item.SubItems.Add(FloatToStr(ExecutionTime));
|
---|
94 | Item.SubItems.Add(IntToStr(ExecutionCount));
|
---|
95 | Item.SubItems.Add(IntToStr(Trunc(Completion * 100)) + '%');
|
---|
96 | Item.SubItems.Add(IntToStr(StackUsed));
|
---|
97 | Item.SubItems.Add(Name);
|
---|
98 | end;
|
---|
99 | finally
|
---|
100 | MainScheduler.MicroThreadsLock.Release;
|
---|
101 | end;
|
---|
102 | end;
|
---|
103 |
|
---|
104 | procedure TMicroThreadListForm.ListView2Data(Sender: TObject; Item: TListItem);
|
---|
105 | var
|
---|
106 | Increment: Integer;
|
---|
107 | begin
|
---|
108 | if MainScheduler.UseMainThread then Increment := 1
|
---|
109 | else Increment := 0;
|
---|
110 |
|
---|
111 | if Item.Index < (MainScheduler.ThreadPoolCount + Increment) then begin
|
---|
112 | if MainScheduler.UseMainThread and (Item.Index = 0) then begin
|
---|
113 | Item.Caption := IntToStr(MainThreadID);
|
---|
114 | Item.SubItems.Add('');
|
---|
115 | Item.SubItems.Add(IntToStr(MainScheduler.MainThreadManager.GetCurrentMicroThreadId));
|
---|
116 | Item.SubItems.Add(FloatToStr(MainScheduler.MainThreadManager.LoopDuration / OneMillisecond) + ' ms');
|
---|
117 | end else
|
---|
118 | try
|
---|
119 | MainScheduler.ThreadPoolLock.Acquire;
|
---|
120 | with TMicroThreadThread(MainScheduler.ThreadPool[Item.Index - Increment]) do begin
|
---|
121 | Item.Caption := IntToStr(ThreadID);
|
---|
122 | Item.SubItems.Add(MicroThreadThreadStateText[State]);
|
---|
123 | Item.SubItems.Add(IntToStr(Manager.GetCurrentMicroThreadId));
|
---|
124 | Item.SubItems.Add(FloatToStr(Manager.LoopDuration / OneMillisecond) + ' ms');
|
---|
125 | end;
|
---|
126 | finally
|
---|
127 | MainScheduler.ThreadPoolLock.Release;
|
---|
128 | end;
|
---|
129 | end;
|
---|
130 | end;
|
---|
131 |
|
---|
132 | procedure TMicroThreadListForm.MenuItemCallStackClick(Sender: TObject);
|
---|
133 | begin
|
---|
134 | if Assigned(ListView1.Selected) then
|
---|
135 | with TMicroThread(ListView1.Selected.Data) do begin
|
---|
136 | //Suspend;
|
---|
137 | CallStackForm.Show(BasePointer);
|
---|
138 | //Resume;
|
---|
139 | end;
|
---|
140 | end;
|
---|
141 |
|
---|
142 | procedure TMicroThreadListForm.FormShow(Sender: TObject);
|
---|
143 | begin
|
---|
144 | TimerRedraw.Enabled := True;
|
---|
145 | end;
|
---|
146 |
|
---|
147 | procedure TMicroThreadListForm.FormHide(Sender: TObject);
|
---|
148 | begin
|
---|
149 | TimerRedraw.Enabled := False;
|
---|
150 | end;
|
---|
151 |
|
---|
152 | procedure TMicroThreadListForm.FormClose(Sender: TObject;
|
---|
153 | var CloseAction: TCloseAction);
|
---|
154 | begin
|
---|
155 | TimerRedraw.Enabled := False;
|
---|
156 | end;
|
---|
157 |
|
---|
158 | procedure TMicroThreadListForm.FormCreate(Sender: TObject);
|
---|
159 | begin
|
---|
160 | CallStackForm := TCallStackForm.Create(nil);
|
---|
161 | end;
|
---|
162 |
|
---|
163 | procedure TMicroThreadListForm.FormDestroy(Sender: TObject);
|
---|
164 | begin
|
---|
165 | CallStackForm.Free;
|
---|
166 | end;
|
---|
167 |
|
---|
168 |
|
---|
169 | end.
|
---|
170 |
|
---|