source: MicroThreading/Demo/UMainForm.pas

Last change on this file was 169, checked in by george, 13 years ago
  • Modified: Reducing some spare methods.
File size: 11.7 KB
Line 
1unit UMainForm;
2
3{$mode Delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9 ComCtrls, ExtCtrls, Spin, Menus, UMicroThreading, DateUtils, UPlatform,
10 UMicroThreadList, UThreadEx;
11
12type
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
123var
124 MainForm: TMainForm;
125
126implementation
127
128{ TTest }
129
130{$R *.lfm}
131
132{ TMainForm }
133
134procedure TMainForm.FormCreate(Sender: TObject);
135begin
136 DoubleBuffered := True;
137// ListView1.DoubleBuffered := True;
138 Event := TMicroThreadEvent.Create;
139 MicroThreadList := TMicroThreadList.Create(Self);
140 UMicroThreading.ExceptionHandler := ShowException;
141 Lock := TMicroThreadCriticalSection.Create;
142end;
143
144procedure TMainForm.ButtonSchedulerStartStopClick(Sender: TObject);
145var
146 I: Integer;
147begin
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;
156end;
157
158procedure TMainForm.Button1Click(Sender: TObject);
159begin
160 Memo1.Clear;
161end;
162
163procedure TMainForm.Button3Click(Sender: TObject);
164begin
165 Event.SetEvent;
166end;
167
168procedure TMainForm.Button4Click(Sender: TObject);
169begin
170 MicroThreadList.Form.Show;
171end;
172
173procedure TMainForm.Button5Click(Sender: TObject);
174begin
175 RaiseException := True;
176end;
177
178procedure TMainForm.Button6Click(Sender: TObject);
179var
180 I: Integer;
181begin
182 //Scheduler.FMicroThreads.Clear;
183 for I := 0 to SpinEdit1.Value - 1 do begin
184 MainScheduler.AddMethod(MethodWorker, False);
185 end;
186end;
187
188procedure TMainForm.Button2Click(Sender: TObject);
189const
190 MaxBlock = MaxInt - $f;
191type
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;
213var
214 I: Integer;
215 FrameAddr: PStackFrame;
216 FrameAddr2: PStackFrame;
217begin
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;
239end;
240
241procedure TMainForm.ButtonAddWorkersClick(Sender: TObject);
242var
243 I: Integer;
244 NewWorker: TWorker;
245begin
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;
252end;
253
254procedure TMainForm.ButtonGetMaxThreadClick(Sender: TObject);
255var
256 NewThread: TThread;
257 I: Integer;
258begin
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;
269end;
270
271procedure TMainForm.ButtonShowThreadIdClick(Sender: TObject);
272begin
273 ShowMessage(IntToStr(GetThreadID));
274end;
275
276procedure TMainForm.ButtonClearMicroThreadsClick(Sender: TObject);
277begin
278 try
279 MainScheduler.MicroThreadsLock.Acquire;
280 MainScheduler.MicroThreads.Clear;
281 finally
282 MainScheduler.MicroThreadsLock.Release;
283 end;
284end;
285
286procedure TMainForm.CheckBox1Change(Sender: TObject);
287begin
288 SleepDuration := SpinEdit4.Value;
289 DoSleep := CheckBox1.Checked;
290end;
291
292procedure TMainForm.CheckBox2Change(Sender: TObject);
293begin
294 DoWriteToMemo := CheckBox2.Checked;
295end;
296
297procedure TMainForm.CheckBox3Change(Sender: TObject);
298begin
299 DoWaitForEvent := CheckBox3.Checked;
300 WaitForEventDuration := SpinEdit5.Value;
301end;
302
303procedure TMainForm.CheckBox4Change(Sender: TObject);
304begin
305 CriticalSectionSleepDuration := SpinEdit6.Value;
306 DoCriticalSection := CheckBox4.Checked;
307end;
308
309procedure TMainForm.CheckBoxUseMainThreadChange(Sender: TObject);
310begin
311 MainScheduler.UseMainThread := CheckBoxUseMainThread.Checked;
312end;
313
314procedure TMainForm.FormDestroy(Sender: TObject);
315begin
316 MicroThreadList.Free;
317 MainScheduler.Active := False;
318 Event.Free;
319 Lock.Free;
320end;
321
322procedure TMainForm.FormShow(Sender: TObject);
323begin
324 Iterations := SpinEdit3.Value;
325 SpinEdit2.Value := 6;
326 ButtonAddWorkers.Click;
327 ButtonSchedulerStartStop.Click;
328 Label16.Caption := IntToStr(MainThreadID);
329end;
330
331procedure TMainForm.ListView2Data(Sender: TObject; Item: TListItem);
332begin
333end;
334
335procedure TMainForm.SpinEdit2Change(Sender: TObject);
336begin
337 MainScheduler.ThreadPoolSize := SpinEdit2.Value;
338end;
339
340procedure TMainForm.SpinEdit3Change(Sender: TObject);
341begin
342 Iterations := SpinEdit3.Value;
343end;
344
345procedure TMainForm.SpinEdit5Change(Sender: TObject);
346begin
347
348end;
349
350procedure TMainForm.SpinEdit6Change(Sender: TObject);
351begin
352end;
353
354procedure TMainForm.TimerRedrawTimer(Sender: TObject);
355begin
356 Label2.Caption := DateTimeToStr(NowPrecise) + ' ' +
357 FloatToStr(Frac(NowPrecise / OneSecond));
358end;
359
360procedure TMainForm.WorkerSubRoutine;
361begin
362 //MTSleep(1 * OneMillisecond);
363end;
364
365procedure TMainForm.ShowException(Sender: TObject; E: Exception);
366begin
367 LastException := E;
368 LastExceptionSender := Sender;
369 if MainThreadID <> ThreadID then
370 TThread.Synchronize(TThreadEx.CurrentThread, DoShowException)
371 else DoShowException;
372end;
373
374procedure TMainForm.DoShowException;
375begin
376 ShowMessage('Exception "' + LastException.Message + '" in class "' +
377 LastExceptionSender.ClassName + '"')
378end;
379
380procedure TMainForm.MethodWorker;
381var
382 I: Integer;
383 Q: Integer;
384begin
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;
408end;
409
410procedure TWorker.Execute;
411var
412 I: Integer;
413 Q: Integer;
414begin
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;
437end;
438
439procedure TWorker.DoWriteToMemo;
440begin
441 MainForm.Memo1.Lines.Add(IntToStr(Id) + ': ' + IntToStr(Trunc(Completion * 100)) + ' %');
442end;
443
444constructor TWorker.Create(CreateSuspended: Boolean; const StackSize: SizeUInt);
445begin
446 inherited;
447end;
448
449destructor TWorker.Destroy;
450begin
451 inherited Destroy;
452end;
453
454end.
455
Note: See TracBrowser for help on using the repository browser.