1 | unit UMainForm;
|
---|
2 |
|
---|
3 | {$mode Delphi}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
---|
9 | ComCtrls, ExtCtrls, Spin, Menus, UMicroThreading, DateUtils, UPlatform,
|
---|
10 | UMicroThreadList, UThreadEx;
|
---|
11 |
|
---|
12 | type
|
---|
13 | TMainForm = class;
|
---|
14 |
|
---|
15 | { TWorker }
|
---|
16 |
|
---|
17 | TWorker = class(TMicroThread)
|
---|
18 | procedure Execute; override;
|
---|
19 | private
|
---|
20 | MainForm: TMainForm;
|
---|
21 | procedure DoWriteToMemo;
|
---|
22 | constructor Create(CreateSuspended: Boolean;
|
---|
23 | const StackSize: SizeUInt = DefaultStackSize);
|
---|
24 | destructor Destroy; override;
|
---|
25 | end;
|
---|
26 |
|
---|
27 | { TMainForm }
|
---|
28 |
|
---|
29 | TMainForm = class(TForm)
|
---|
30 | Button1: TButton;
|
---|
31 | Button2: TButton;
|
---|
32 | Button3: TButton;
|
---|
33 | Button4: TButton;
|
---|
34 | Button5: TButton;
|
---|
35 | Button6: TButton;
|
---|
36 | ButtonAddWorkers: TButton;
|
---|
37 | ButtonClearMicroThreads: TButton;
|
---|
38 | ButtonGetMaxThread: TButton;
|
---|
39 | ButtonSchedulerStartStop: TButton;
|
---|
40 | ButtonShowThreadId: TButton;
|
---|
41 | CheckBox1: TCheckBox;
|
---|
42 | CheckBox2: TCheckBox;
|
---|
43 | CheckBox3: TCheckBox;
|
---|
44 | CheckBox4: TCheckBox;
|
---|
45 | CheckBoxUseMainThread: TCheckBox;
|
---|
46 | GroupBox1: TGroupBox;
|
---|
47 | GroupBox2: TGroupBox;
|
---|
48 | GroupBox3: TGroupBox;
|
---|
49 | Label11: TLabel;
|
---|
50 | Label12: TLabel;
|
---|
51 | Label14: TLabel;
|
---|
52 | Label15: TLabel;
|
---|
53 | Label16: TLabel;
|
---|
54 | Label17: TLabel;
|
---|
55 | Label18: TLabel;
|
---|
56 | Label2: TLabel;
|
---|
57 | Label3: TLabel;
|
---|
58 | Label4: TLabel;
|
---|
59 | MainMenu1: TMainMenu;
|
---|
60 | Memo1: TMemo;
|
---|
61 | MenuItem1: TMenuItem;
|
---|
62 | MenuItem2: TMenuItem;
|
---|
63 | MenuItem3: TMenuItem;
|
---|
64 | MenuItem4: TMenuItem;
|
---|
65 | PageControl1: TPageControl;
|
---|
66 | SpinEdit1: TSpinEdit;
|
---|
67 | SpinEdit2: TSpinEdit;
|
---|
68 | SpinEdit3: TSpinEdit;
|
---|
69 | SpinEdit4: TSpinEdit;
|
---|
70 | SpinEdit5: TSpinEdit;
|
---|
71 | SpinEdit6: TSpinEdit;
|
---|
72 | TabSheet1: TTabSheet;
|
---|
73 | TabSheet2: TTabSheet;
|
---|
74 | TabSheet3: TTabSheet;
|
---|
75 | TimerRedraw: TTimer;
|
---|
76 | procedure Button1Click(Sender: TObject);
|
---|
77 | procedure Button3Click(Sender: TObject);
|
---|
78 | procedure Button4Click(Sender: TObject);
|
---|
79 | procedure Button5Click(Sender: TObject);
|
---|
80 | procedure Button6Click(Sender: TObject);
|
---|
81 | procedure ButtonSchedulerStartStopClick(Sender: TObject);
|
---|
82 | procedure Button2Click(Sender: TObject);
|
---|
83 | procedure ButtonAddWorkersClick(Sender: TObject);
|
---|
84 | procedure ButtonGetMaxThreadClick(Sender: TObject);
|
---|
85 | procedure ButtonShowThreadIdClick(Sender: TObject);
|
---|
86 | procedure ButtonClearMicroThreadsClick(Sender: TObject);
|
---|
87 | procedure CheckBox1Change(Sender: TObject);
|
---|
88 | procedure CheckBox2Change(Sender: TObject);
|
---|
89 | procedure CheckBox3Change(Sender: TObject);
|
---|
90 | procedure CheckBox4Change(Sender: TObject);
|
---|
91 | procedure CheckBoxUseMainThreadChange(Sender: TObject);
|
---|
92 | procedure FormCreate(Sender: TObject);
|
---|
93 | procedure FormDestroy(Sender: TObject);
|
---|
94 | procedure FormShow(Sender: TObject);
|
---|
95 | procedure ListView2Data(Sender: TObject; Item: TListItem);
|
---|
96 | procedure SpinEdit2Change(Sender: TObject);
|
---|
97 | procedure SpinEdit3Change(Sender: TObject);
|
---|
98 | procedure SpinEdit5Change(Sender: TObject);
|
---|
99 | procedure SpinEdit6Change(Sender: TObject);
|
---|
100 | procedure TimerRedrawTimer(Sender: TObject);
|
---|
101 | private
|
---|
102 | MicroThreadList: TMicroThreadList;
|
---|
103 | Lock: TMicroThreadCriticalSection;
|
---|
104 | LastException: Exception;
|
---|
105 | LastExceptionSender: TObject;
|
---|
106 | procedure WorkerSubRoutine;
|
---|
107 | procedure ShowException(Sender: TObject; E: Exception);
|
---|
108 | procedure DoShowException;
|
---|
109 | procedure MethodWorker;
|
---|
110 | public
|
---|
111 | DoWriteToMemo: Boolean;
|
---|
112 | DoSleep: Boolean;
|
---|
113 | DoCriticalSection: Boolean;
|
---|
114 | RaiseException: Boolean;
|
---|
115 | SleepDuration: Integer;
|
---|
116 | CriticalSectionSleepDuration: Integer;
|
---|
117 | DoWaitForEvent: Boolean;
|
---|
118 | Event: TMicroThreadEvent;
|
---|
119 | WaitForEventDuration: Integer;
|
---|
120 | Iterations: Integer;
|
---|
121 | end;
|
---|
122 |
|
---|
123 | var
|
---|
124 | MainForm: TMainForm;
|
---|
125 |
|
---|
126 | implementation
|
---|
127 |
|
---|
128 | { TTest }
|
---|
129 |
|
---|
130 | {$R *.lfm}
|
---|
131 |
|
---|
132 | { TMainForm }
|
---|
133 |
|
---|
134 | procedure TMainForm.FormCreate(Sender: TObject);
|
---|
135 | begin
|
---|
136 | DoubleBuffered := True;
|
---|
137 | // ListView1.DoubleBuffered := True;
|
---|
138 | Event := TMicroThreadEvent.Create;
|
---|
139 | MicroThreadList := TMicroThreadList.Create(Self);
|
---|
140 | UMicroThreading.ExceptionHandler := ShowException;
|
---|
141 | Lock := TMicroThreadCriticalSection.Create;
|
---|
142 | end;
|
---|
143 |
|
---|
144 | procedure TMainForm.ButtonSchedulerStartStopClick(Sender: TObject);
|
---|
145 | var
|
---|
146 | I: Integer;
|
---|
147 | begin
|
---|
148 | if ButtonSchedulerStartStop.Caption = 'Start scheduler' then begin
|
---|
149 | ButtonSchedulerStartStop.Caption := 'Stop scheduler';
|
---|
150 | MainScheduler.ThreadPoolSize := SpinEdit2.Value;
|
---|
151 | MainScheduler.Active := True;
|
---|
152 | end else begin
|
---|
153 | ButtonSchedulerStartStop.Caption := 'Start scheduler';
|
---|
154 | MainScheduler.Active := False;
|
---|
155 | end;
|
---|
156 | end;
|
---|
157 |
|
---|
158 | procedure TMainForm.Button1Click(Sender: TObject);
|
---|
159 | begin
|
---|
160 | Memo1.Clear;
|
---|
161 | end;
|
---|
162 |
|
---|
163 | procedure TMainForm.Button3Click(Sender: TObject);
|
---|
164 | begin
|
---|
165 | Event.SetEvent;
|
---|
166 | end;
|
---|
167 |
|
---|
168 | procedure TMainForm.Button4Click(Sender: TObject);
|
---|
169 | begin
|
---|
170 | MicroThreadList.Form.Show;
|
---|
171 | end;
|
---|
172 |
|
---|
173 | procedure TMainForm.Button5Click(Sender: TObject);
|
---|
174 | begin
|
---|
175 | RaiseException := True;
|
---|
176 | end;
|
---|
177 |
|
---|
178 | procedure TMainForm.Button6Click(Sender: TObject);
|
---|
179 | var
|
---|
180 | I: Integer;
|
---|
181 | begin
|
---|
182 | //Scheduler.FMicroThreads.Clear;
|
---|
183 | for I := 0 to SpinEdit1.Value - 1 do begin
|
---|
184 | MainScheduler.AddMethod(MethodWorker, False);
|
---|
185 | end;
|
---|
186 | end;
|
---|
187 |
|
---|
188 | procedure TMainForm.Button2Click(Sender: TObject);
|
---|
189 | const
|
---|
190 | MaxBlock = MaxInt - $f;
|
---|
191 | type
|
---|
192 | PBytes = ^TBytes;
|
---|
193 | TBytes = array[0..MaxBlock div SizeOf(Byte)] of Byte;
|
---|
194 | PDWORDS = ^TDWORDS;
|
---|
195 | TDWORDS = array[0..MaxBlock div SizeOf(DWORD)] of DWORD;
|
---|
196 | PStackFrame = ^TStackFrame;
|
---|
197 | TStackFrame = record
|
---|
198 | CallersEBP: PStackFrame;
|
---|
199 | CallerAdr: DWORD;
|
---|
200 | end;
|
---|
201 | TStackInfo = record
|
---|
202 | CallerAdr: DWORD;
|
---|
203 | Level: DWORD;
|
---|
204 | CallersEBP: DWORD;
|
---|
205 | DumpSize: DWORD;
|
---|
206 | ParamSize: DWORD;
|
---|
207 | ParamPtr: PDWORDS;
|
---|
208 | case integer of
|
---|
209 | 0: (StackFrame: PStackFrame);
|
---|
210 | 1: (DumpPtr: PBytes);
|
---|
211 | end;
|
---|
212 | PStackInfo = ^TStackInfo;
|
---|
213 | var
|
---|
214 | I: Integer;
|
---|
215 | FrameAddr: PStackFrame;
|
---|
216 | FrameAddr2: PStackFrame;
|
---|
217 | begin
|
---|
218 | (* for I := 0 to 100 do begin
|
---|
219 | Memo1.Lines.Add(IntToStr(I));
|
---|
220 | Sleep(10);
|
---|
221 | Application.ProcessMessages;
|
---|
222 | end;
|
---|
223 | *)
|
---|
224 | FrameAddr := get_frame;
|
---|
225 | Memo1.Lines.Add('get_frame: ' + IntToHex(Integer(FrameAddr), 8));
|
---|
226 | Memo1.Lines.Add('get_caller_addr: ' + IntToHex(Integer(get_caller_addr(get_frame)), 8));
|
---|
227 | Memo1.Lines.Add('get_caller_frame: ' + IntToHex(Integer(get_caller_frame(get_frame)), 8));
|
---|
228 | Memo1.Lines.Add(IntToHex(Integer(FrameAddr^.CallersEBP), 8));
|
---|
229 | Memo1.Lines.Add(IntToHex(FrameAddr^.CallerAdr, 8));
|
---|
230 |
|
---|
231 | for I := 0 to 10 do begin
|
---|
232 | Memo1.Lines.Add('Stack frame ' + IntToStr(I));
|
---|
233 | Memo1.Lines.Add(IntToHex(Integer(FrameAddr^.CallersEBP), 8));
|
---|
234 | Memo1.Lines.Add(IntToHex(FrameAddr^.CallerAdr, 8));
|
---|
235 | Memo1.Lines.Add('Size: ' + IntToStr(Integer(FrameAddr^.CallersEBP) - Integer(FrameAddr)));
|
---|
236 | FrameAddr := FrameAddr^.CallersEBP;
|
---|
237 | end;
|
---|
238 | //FrameAddr^.CallerAdr := FrameAddr2^.CallerAdr;
|
---|
239 | end;
|
---|
240 |
|
---|
241 | procedure TMainForm.ButtonAddWorkersClick(Sender: TObject);
|
---|
242 | var
|
---|
243 | I: Integer;
|
---|
244 | NewWorker: TWorker;
|
---|
245 | begin
|
---|
246 | //Scheduler.FMicroThreads.Clear;
|
---|
247 | for I := 0 to SpinEdit1.Value - 1 do begin
|
---|
248 | NewWorker := TWorker.Create(True);
|
---|
249 | NewWorker.MainForm := Self;
|
---|
250 | NewWorker.Start;
|
---|
251 | end;
|
---|
252 | end;
|
---|
253 |
|
---|
254 | procedure TMainForm.ButtonGetMaxThreadClick(Sender: TObject);
|
---|
255 | var
|
---|
256 | NewThread: TThread;
|
---|
257 | I: Integer;
|
---|
258 | begin
|
---|
259 | try
|
---|
260 | I := 0;
|
---|
261 | while True do begin
|
---|
262 | NewThread := TThread.Create(True);
|
---|
263 | NewThread.FreeOnTerminate:= False;
|
---|
264 | Inc(I);
|
---|
265 | end;
|
---|
266 | except
|
---|
267 | ShowMessage('Application can create ' + IntToStr(I) +' TThread instances');
|
---|
268 | end;
|
---|
269 | end;
|
---|
270 |
|
---|
271 | procedure TMainForm.ButtonShowThreadIdClick(Sender: TObject);
|
---|
272 | begin
|
---|
273 | ShowMessage(IntToStr(GetThreadID));
|
---|
274 | end;
|
---|
275 |
|
---|
276 | procedure TMainForm.ButtonClearMicroThreadsClick(Sender: TObject);
|
---|
277 | begin
|
---|
278 | try
|
---|
279 | MainScheduler.MicroThreadsLock.Acquire;
|
---|
280 | MainScheduler.MicroThreads.Clear;
|
---|
281 | finally
|
---|
282 | MainScheduler.MicroThreadsLock.Release;
|
---|
283 | end;
|
---|
284 | end;
|
---|
285 |
|
---|
286 | procedure TMainForm.CheckBox1Change(Sender: TObject);
|
---|
287 | begin
|
---|
288 | SleepDuration := SpinEdit4.Value;
|
---|
289 | DoSleep := CheckBox1.Checked;
|
---|
290 | end;
|
---|
291 |
|
---|
292 | procedure TMainForm.CheckBox2Change(Sender: TObject);
|
---|
293 | begin
|
---|
294 | DoWriteToMemo := CheckBox2.Checked;
|
---|
295 | end;
|
---|
296 |
|
---|
297 | procedure TMainForm.CheckBox3Change(Sender: TObject);
|
---|
298 | begin
|
---|
299 | DoWaitForEvent := CheckBox3.Checked;
|
---|
300 | WaitForEventDuration := SpinEdit5.Value;
|
---|
301 | end;
|
---|
302 |
|
---|
303 | procedure TMainForm.CheckBox4Change(Sender: TObject);
|
---|
304 | begin
|
---|
305 | CriticalSectionSleepDuration := SpinEdit6.Value;
|
---|
306 | DoCriticalSection := CheckBox4.Checked;
|
---|
307 | end;
|
---|
308 |
|
---|
309 | procedure TMainForm.CheckBoxUseMainThreadChange(Sender: TObject);
|
---|
310 | begin
|
---|
311 | MainScheduler.UseMainThread := CheckBoxUseMainThread.Checked;
|
---|
312 | end;
|
---|
313 |
|
---|
314 | procedure TMainForm.FormDestroy(Sender: TObject);
|
---|
315 | begin
|
---|
316 | MicroThreadList.Free;
|
---|
317 | MainScheduler.Active := False;
|
---|
318 | Event.Free;
|
---|
319 | Lock.Free;
|
---|
320 | end;
|
---|
321 |
|
---|
322 | procedure TMainForm.FormShow(Sender: TObject);
|
---|
323 | begin
|
---|
324 | Iterations := SpinEdit3.Value;
|
---|
325 | SpinEdit2.Value := 6;
|
---|
326 | ButtonAddWorkers.Click;
|
---|
327 | ButtonSchedulerStartStop.Click;
|
---|
328 | Label16.Caption := IntToStr(MainThreadID);
|
---|
329 | end;
|
---|
330 |
|
---|
331 | procedure TMainForm.ListView2Data(Sender: TObject; Item: TListItem);
|
---|
332 | begin
|
---|
333 | end;
|
---|
334 |
|
---|
335 | procedure TMainForm.SpinEdit2Change(Sender: TObject);
|
---|
336 | begin
|
---|
337 | MainScheduler.ThreadPoolSize := SpinEdit2.Value;
|
---|
338 | end;
|
---|
339 |
|
---|
340 | procedure TMainForm.SpinEdit3Change(Sender: TObject);
|
---|
341 | begin
|
---|
342 | Iterations := SpinEdit3.Value;
|
---|
343 | end;
|
---|
344 |
|
---|
345 | procedure TMainForm.SpinEdit5Change(Sender: TObject);
|
---|
346 | begin
|
---|
347 |
|
---|
348 | end;
|
---|
349 |
|
---|
350 | procedure TMainForm.SpinEdit6Change(Sender: TObject);
|
---|
351 | begin
|
---|
352 | end;
|
---|
353 |
|
---|
354 | procedure TMainForm.TimerRedrawTimer(Sender: TObject);
|
---|
355 | begin
|
---|
356 | Label2.Caption := DateTimeToStr(NowPrecise) + ' ' +
|
---|
357 | FloatToStr(Frac(NowPrecise / OneSecond));
|
---|
358 | end;
|
---|
359 |
|
---|
360 | procedure TMainForm.WorkerSubRoutine;
|
---|
361 | begin
|
---|
362 | //MTSleep(1 * OneMillisecond);
|
---|
363 | end;
|
---|
364 |
|
---|
365 | procedure TMainForm.ShowException(Sender: TObject; E: Exception);
|
---|
366 | begin
|
---|
367 | LastException := E;
|
---|
368 | LastExceptionSender := Sender;
|
---|
369 | if MainThreadID <> ThreadID then
|
---|
370 | TThread.Synchronize(TThreadEx.CurrentThread, DoShowException)
|
---|
371 | else DoShowException;
|
---|
372 | end;
|
---|
373 |
|
---|
374 | procedure TMainForm.DoShowException;
|
---|
375 | begin
|
---|
376 | ShowMessage('Exception "' + LastException.Message + '" in class "' +
|
---|
377 | LastExceptionSender.ClassName + '"')
|
---|
378 | end;
|
---|
379 |
|
---|
380 | procedure TMainForm.MethodWorker;
|
---|
381 | var
|
---|
382 | I: Integer;
|
---|
383 | Q: Integer;
|
---|
384 | begin
|
---|
385 | for I := 0 to MainForm.Iterations - 1 do begin
|
---|
386 | Q := 0;
|
---|
387 | while Q < 100000 do Inc(Q);
|
---|
388 | if MainForm.DoWriteToMemo then
|
---|
389 | MainForm.Memo1.Lines.Add(IntToStr(GetCurrentMicroThread.Id) + ': ' + IntToStr(Trunc(GetCurrentMicroThread.Completion * 100)) + ' %');
|
---|
390 | if MainForm.DoWaitForEvent then MainForm.Event.WaitFor(MainForm.WaitForEventDuration * OneMillisecond);
|
---|
391 | if MainForm.DoSleep then MTSleep(MainForm.SleepDuration * OneMillisecond);
|
---|
392 | if MainForm.RaiseException then begin
|
---|
393 | MainForm.RaiseException := False;
|
---|
394 | raise Exception.Create('Exception from microthread');
|
---|
395 | end;
|
---|
396 | if MainForm.DoCriticalSection then begin
|
---|
397 | try
|
---|
398 | MainForm.Lock.Acquire;
|
---|
399 | MTSleep(MainForm.CriticalSectionSleepDuration * OneMillisecond);
|
---|
400 | finally
|
---|
401 | MainForm.Lock.Release;
|
---|
402 | end;
|
---|
403 | end;
|
---|
404 | //WorkerSubRoutine;
|
---|
405 | GetCurrentMicroThread.Completion := I / MainForm.Iterations;
|
---|
406 | GetCurrentMicroThread.Yield;
|
---|
407 | end;
|
---|
408 | end;
|
---|
409 |
|
---|
410 | procedure TWorker.Execute;
|
---|
411 | var
|
---|
412 | I: Integer;
|
---|
413 | Q: Integer;
|
---|
414 | begin
|
---|
415 | for I := 0 to MainForm.Iterations - 1 do begin
|
---|
416 | Q := 0;
|
---|
417 | while Q < 100000 do Inc(Q);
|
---|
418 | if MainForm.DoWriteToMemo then Synchronize(DoWriteToMemo);
|
---|
419 | if MainForm.DoWaitForEvent then MainForm.Event.WaitFor(MainForm.WaitForEventDuration * OneMillisecond);
|
---|
420 | if MainForm.DoSleep then MTSleep(MainForm.SleepDuration * OneMillisecond);
|
---|
421 | if MainForm.RaiseException then begin
|
---|
422 | MainForm.RaiseException := False;
|
---|
423 | raise Exception.Create('Exception from microthread');
|
---|
424 | end;
|
---|
425 | if MainForm.DoCriticalSection then begin
|
---|
426 | try
|
---|
427 | MainForm.Lock.Acquire;
|
---|
428 | MTSleep(MainForm.CriticalSectionSleepDuration * OneMillisecond);
|
---|
429 | finally
|
---|
430 | MainForm.Lock.Release;
|
---|
431 | end;
|
---|
432 | end;
|
---|
433 | //WorkerSubRoutine;
|
---|
434 | Completion := I / MainForm.Iterations;
|
---|
435 | Yield;
|
---|
436 | end;
|
---|
437 | end;
|
---|
438 |
|
---|
439 | procedure TWorker.DoWriteToMemo;
|
---|
440 | begin
|
---|
441 | MainForm.Memo1.Lines.Add(IntToStr(Id) + ': ' + IntToStr(Trunc(Completion * 100)) + ' %');
|
---|
442 | end;
|
---|
443 |
|
---|
444 | constructor TWorker.Create(CreateSuspended: Boolean; const StackSize: SizeUInt);
|
---|
445 | begin
|
---|
446 | inherited;
|
---|
447 | end;
|
---|
448 |
|
---|
449 | destructor TWorker.Destroy;
|
---|
450 | begin
|
---|
451 | inherited Destroy;
|
---|
452 | end;
|
---|
453 |
|
---|
454 | end.
|
---|
455 |
|
---|