Threading problems

[vargatam77]

hey all

I try to implement a basic threading from freepascal wiki, but when i create a second thread the app freezes up. here is the whole of the code

Code: Pascal  [Select][+][-]

1. unit main;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Menus,
9.   ComCtrls, StdCtrls;
10.  
11. Type
12.     TShowStatusEvent = procedure(Status: String) of Object;
13.  
14.     TMyThread = class(TThread)
15.     private
16.       fStatusText : string;
17.       FOnShowStatus: TShowStatusEvent;
18.       procedure ShowStatus;
19.     protected
20.       procedure Execute; override;
21.     public
22.       Constructor Create(CreateSuspended : boolean);
23.       property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
24.     end;
25.  
26. type
27.  
28.   { TfrmMain }
29.  
30.   TfrmMain = class(TForm)
31.     btnStart: TButton;
32.     mnuToMonitor4: TMenuItem;
33.     mnuToMonitor3: TMenuItem;
34.     mnuToMonitor2: TMenuItem;
35.     mnuToMonitor1: TMenuItem;
36.     mnuSep4: TMenuItem;
37.     mnuToMonitor: TMenuItem;
38.     mnuMainQuit: TMenuItem;
39.     mnuSep3: TMenuItem;
40.     mnuMainToTray: TMenuItem;
41.     mnuFile: TMenuItem;
42.     mnuMain: TMainMenu;
43.     mnuQuit: TMenuItem;
44.     mnuSep2: TMenuItem;
45.     mnuCurrent: TMenuItem;
46.     mnuCentre: TMenuItem;
47.     mnuSep1: TMenuItem;
48.     mnuShow: TMenuItem;
49.     mnuTray: TPopupMenu;
50.     sbStatus: TStatusBar;
51.     sysTray: TTrayIcon;
52.     tGetCardInfo: TTimer;
53.     tvAudio: TTreeView;
54.     procedure btnStartClick(Sender: TObject);
55.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
56.     procedure FormCreate(Sender: TObject);
57.     procedure FormWindowStateChange(Sender: TObject);
58.     procedure mnuCentreClick(Sender: TObject);
59.     procedure mnuCurrentClick(Sender: TObject);
60.     procedure mnuQuitClick(Sender: TObject);
61.     procedure mnuShowClick(Sender: TObject);
62.     procedure mnuToMonitor1Click(Sender: TObject);
63.   private
64.     threadCounter: Integer;
65.     threads: array[0..9] of TMyThread;
66.     procedure centerOnMonitor(Mon: TMonitor);
67.   public
68.     procedure onShowStatus(status: string);
69.   end;
70.  
71. var
72.   frmMain: TfrmMain;
73.  
74. implementation
75.  
76. {TMyThread}
77.  
78. constructor TMyThread.Create(CreateSuspended : boolean);
79. begin
80.   inherited Create(CreateSuspended);
81.   FreeOnTerminate := True;
82. end;
83.  
84. procedure TMyThread.ShowStatus;
85. begin
86.   if Assigned(FOnShowStatus) then
87.   begin
88.     FOnShowStatus(fStatusText);
89.   end;
90. end;
91.  
92. procedure TMyThread.Execute;
93. var
94.   newStatus : string;
95.   counter: Integer;
96. begin
97.   counter:= 0;
98.   fStatusText := 'TMyThread Starting...';
99.   Synchronize(@ShowStatus);
100.   newStatus := 'TMyThread Running...';
101.  
102.   while (not Terminated) and (counter < 100000) do
103.   begin
104.     if newStatus <> fStatusText then
105.     begin
106.       fStatusText := newStatus;
107.       Synchronize(@ShowStatus);
108.     end;
109.  
110.     Inc(counter);
111.     newStatus:= IntToStr(counter);
112.   end;
113.  
114.   fStatusText := 'TMyThread Finished...';
115.   Synchronize(@ShowStatus);
116. end;
117.  
118. {$R *.lfm}
119.  
120. { TfrmMain }
121.  
122. procedure TfrmMain.FormCreate(Sender: TObject);
123. var
124.   i: Integer;
125.   mnuItem: TMenuItem;
126. begin
127.      threadCounter:= 0;
128.      if Screen.MonitorCount > 1 then
129.      begin
130.        mnuToMonitor.Enabled:=true;
131.        for i:= 0 to Screen.MonitorCount - 1 do
132.        begin
133.             mnuItem:= TMenuItem.Create(mnuToMonitor);
134.             mnuItem.Caption:= 'Monitor' + IntToStr(i);
135.             mnuItem.Name:= 'mnuToMonitor' + IntToStr(i);
136.             mnuitem.Tag:= i;
137.             mnuItem.Visible:= true;
138.             mnuItem.Enabled:= true;
139.             mnuItem.OnClick:= @mnuToMonitor1Click;
140.             mnuToMonitor.Add(mnuItem);
141.        end;
142.      end;
143. end;
144.  
145. procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
146. begin
147.      CanClose:= MessageDlg('Do you really want to quit?', mtConfirmation, [mbYes, mbNo], 0) = mrYes
148. end;
149.  
150. procedure TfrmMain.btnStartClick(Sender: TObject);
151. begin
152.      threads[threadCounter]:= TMyThread.Create(true);
153.      threads[threadCounter].OnShowStatus := @onShowStatus;
154.      threads[threadCounter].Start;
155.      Inc(threadCounter);
156. end;
157.  
158. procedure TfrmMain.onShowStatus(status: string);
159. var
160.   item: TTreeNode;
161. begin
162.   item:= tvAudio.Items.AddChild(tvAudio.Items[0], status);
163.   item.MakeVisible;
164. end;
165.  
166. procedure TfrmMain.FormWindowStateChange(Sender: TObject);
167. begin
168.      if (WindowState = wsMinimized) and (mnuMainToTray.Checked) then Hide;
169. end;
170.  
171. procedure TfrmMain.mnuCentreClick(Sender: TObject);
172. begin
173.      centerOnMonitor(Screen.MonitorFromWindow(Self.Handle));
174. end;
175.  
176. procedure TfrmMain.mnuCurrentClick(Sender: TObject);
177. begin
178.      centerOnMonitor(Screen.MonitorFromPoint(Mouse.CursorPos));
179. end;
180.  
181. procedure TfrmMain.mnuToMonitor1Click(Sender: TObject);
182. begin
183.      centerOnMonitor(Screen.Monitors[TMenuItem(Sender).Tag]);
184. end;
185.  
186. procedure TfrmMain.mnuQuitClick(Sender: TObject);
187. begin
188.      if MessageDlg('Do you really want to quit?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then Application.Terminate;
189. end;
190.  
191. procedure TfrmMain.mnuShowClick(Sender: TObject);
192. begin
193.      frmMain.WindowState := wsNormal;
194.      Show;
195. end;
196.  
197. procedure TfrmMain.centerOnMonitor(Mon: TMonitor);
198. begin
199.      Left:= Mon.Left + (Mon.Width - Width) div 2;
200.      Top:= Mon.Top  + (Mon.Height - Height) div 2;
201. end;
202.  
203. end.
204.  

I get no errors, just freezes/locks up on second click. if i change Synchronise to Queue then it freezes up right at first activation... (sometimes I get raised exception class 'External: SIGSEGV' error with Queue)

any ideas please?

[marcov]

The cross thread traffic is much slower than the loop. Try adding a sleep(1000) to the loop in the thread

[LV]

Throttle UI updates in Execute

Code: Pascal  [Select][+][-]

1. lastTick := GetTickCount64;
2. while (not Terminated) and (counter < 100000) do
3. begin
4.   Inc(counter);
5.  
6.   // only update the UI every 100 ms (adjust as needed)
7.   if GetTickCount64 - lastTick >= 100 then
8.   begin
9.     fStatusText := IntToStr(counter);
10.     Synchronize(@ShowStatus);
11.     lastTick := GetTickCount64;
12.   end;
13. end;
14.  

[Thaddy]

Throttling threads with sleep is always wrong. I will add example later.
Try yield instead.

[marcov]

Throttling threads with sleep is always wrong. I will add example later.
Try yield instead.

My SDK has:

Code: [Select]

WinBase.h
#define Yield()

with a note that it is a windows 3.11 legacy cooperative multitasking artifact.  Afaik sleep(0) is documented to be the same as yield in preemptive versions of Windows

.... but anyway, that will still be way too fast.

[Thaddy]

with a note that it is a windows 3.11 legacy cooperative multitasking artifact.  Afaik sleep(0) is documented to be the same as yield in preemptive versions of Windows

No, nothing to do with that: Yield is properly implemented and does not equal the old windoze sleep(0) (relinquish timeslice a.k.a. oldtime yield)
It is definitely not deprecated in TThread.

I am a bit surprised you did not know that?

[marcov]

with a note that it is a windows 3.11 legacy cooperative multitasking artifact.  Afaik sleep(0) is documented to be the same as yield in preemptive versions of Windows

No, nothing to do with that: Yield is properly implemented and does not equal the old windoze sleep(0) (relinquish timeslice a.k.a. oldtime yield)
It is definitely not deprecated in TThread.

I am a bit surprised you did not know that?

Code: [Select]

class procedure TThread.Yield;
begin
{$ifdef FPC_HAS_FEATURE_THREADING}
  ThreadSwitch;
{$endif}
end;

// win32/64 implementation:
    procedure SysThreadSwitch;
    begin
      Sleep(0);
    end;

But I stand corrected at least partially. I was thinking in winapi terms, and you meant a platform independent TThread level abstraction, which is always better.

But for this thread, if it runs on Windows it doesn't matter, giving up a timeslice still synchronizes way too much with the main thread.

[vargatam77]

But for this thread, if it runs on Windows

If I was on Windows... I would just use BCB6...

So let me get this straight, Threads in lcl cant maintain queues if its too "fast"? even js can do it and its not even multithreaded... Btw, yeah, i slowed down the threads and its working, for now, but again, how much should i slow it down if i start a 100 threads? or a 1000 threads?

Try yield instead.

could you please give me a short example how to use it?

[Thaddy]

@marov

Yes, that is true, but that can not be mitigated by high level code: it is an OS problem.

[Thaddy]

Absolute nonsence.
Stick a sock in it or provide code. (you can't)

[marcov]

But for this thread, if it runs on Windows

If I was on Windows... I would just use BCB6...

Well, to each his own form of taste.

So let me get this straight, Threads in lcl cant maintain queues if its too "fast"? even js can do it and its not even multithreaded...

It is basic programming logic. If queueing is faster than de-queueing, the queue will eventually overflow. If the de-queueing involves OS calls to write to screen or update GUI, that is quite often the case, specially in this case where the thread basically is a no-op loop on IPC timescale.

The behaviour might be OS and OS version dependent, as well as in RTL (primitives might change over time) as it is a simply weighing of OS primitives used in the queueing code vs the de-queuing code.

It is probably not the queue that causes the crash however, but something else in your program dies if the mainthread doesn't get enough ticks. 

I don't know much about the internals of JS engines (I assume they at least JIT a bit), nor am I terribly interested in it, but I know some more popular languages also have an additional cooperative multitasking lightweight thread concept that might have different tradeoffs. Anyway runtime and technique of JS is so vastly different that probably nothing practical will come from such comparison.

Btw, yeah, i slowed down the threads and its working, for now, but again, how much should i slow it down if i start a 100 threads? or a 1000 threads?

Updating the GUI more often than the eye can see is effectively busy waiting and not doing work. Why update it tens of thousand times per second or more? Most people don't notice anything faster than 0.1-0.2s if they don't pay particular attention and know what to look out for.

Try yield instead.

could you please give me a short example how to use it?

That was Thaddy's suggestion, not mine. IMHO yield() will still be too fast, and worse, arbitrary. If the machine gets faster, the gui is updated even more often, negating the improved hardware.

I would simply rate limit your GUI updates to more sane magnitudes like 50ms or so, on Windows I do that with queryperformancecounter and friends.  I believe FPC 3.2.0 and later has sysutils.gettickcount64 that could be used to make this somewhat portable.

[jamie]

The GUI and controls that live in it are message and /event driven. That means many controls require messages to be processed.

 One thing that comes to mind is that it's needed calling the Application.ProcessMessages to the GUI can suck down the message pool.

  This can be done before the Synchronize method is returned.

 It's just an idea to test...


 Jamie

[vargatam77]

Updating the GUI more often than the eye can see is effectively busy waiting and not doing work. Why update it tens of thousand times per second or more? Most people don't notice anything faster than 0.1-0.2s if they don't pay particular attention and know what to look out for.

Yeah, I know this, and honestly I appreciate your patience and the explanation. Mind this was just a first test to see how threading works, what I will do it really just reading settings from files, querying hardware, reading outputs of drivers etc and many of them will answer immediately... but what is the point if i have to manually slow down the quick ones. i would be better off to just query them from the main thread, at least there will be no artificial waiting. They will just block each others and do the job linearly...

[vargatam77]

The GUI and controls that live in it are message and /event driven. That means many controls require messages to be processed.

 One thing that comes to mind is that it's needed calling the Application.ProcessMessages to the GUI can suck down the message pool.

  This can be done before the Synchronize method is returned.

 It's just an idea to test...


 Jamie

I will try this, though in theory it is there for the mean thread to dont block processing the message queue, here in theory this is not happening, there are no infinite loops in the main thread, its exactly the message processing cogs up because there are "too many messages". and sync is thread blocking, so each message waits until the main thread finishes processing the message before it returns to the thread, they shouldnt block each others. but again, i will try it, im not really into how lazarus internally solves this, maybe 2 messages between the gui refreshes are coming too quick??? im not sure, so thanks for the idea

[cdbc]

Hi
Use a MessageQueue for the comms...
Regards Benny

eta: If you need such a beast 
I have one in THIS Gitlab repo, it's located in the 'utils' directory...