I am reading "Delphi High performance" and there is something that I am missing. Given this code as test:
type TTest = class(TThread)
private
amemo: TMemo;
public
constructor Create(ss: boolean; memo: TMemo);
protected
procedure Execute; override;
end;
constructor TTest.Create(ss: boolean; memo: TMemo);
begin
inherited Create(ss);
FreeOnTerminate := true;
amemo := memo;
end;
procedure TTest.Execute;
var i: uint32;
begin
inherited;
i := 0;
while not Terminated do
begin
Inc(i);
Synchronize(procedure
begin amemo.Lines.Add(i.ToString) end);
Sleep(1000);
end;
end;
Very simply, this thread prints some numbers in a memo. I start the thread suspended and so I have to call this piece of code:
procedure TForm1.Button1Click(Sender: TObject);
begin
thread := TTest.Create(true, Memo1);
thread.Start;
end;
I have always stopped the thread calling thread.Terminate; but reading the book I see that Primoz stops a thread like this:
procedure TForm1.Button2Click(Sender: TObject);
begin
thread.Terminate;
thread.WaitFor; //he adds this method call
//FreeAndNil(thread)
//there is the above line as well in the code copied from the book but I have removed it since I have set FreeOnTerminate := true (so I dont have to worry about freeing the obj).
end;
At this point, if I run the code using only Terminate I have no problems. If I run the code with Terminate + WaitFor I get this error:
I have read more coding in delphi too and I see that Nick Hodges just makes a call to Terminate;. Is calling Terminate; enough to safey stop a thread? Note that I've set FreeOnTerminate := true so I don't care about the death of the object. Terminated should stop the execution (what is inside execute) and so it should be like this:
Call Terminated
Execute stops
Thread stops execution
Thread is now free (FreeOnTerminate := true)
Please tell me what I'm missing.
Note.
In the book the thread doesn't have FreeOnTerminate := true. So the thread needs to be freed manually; I guess that this is the reason why he calls
thread.Terminate;
thread.WaitFor;
FreeAndNil(thread)
I agree on Terminate (stop the thread= and FreeAndNil (free the object manually) but the WaitFor?
Please tell me what I'm missing.
The documentation for FreeOnTerminate explicitly says that you cannot use the Thread in any way after Terminate.
That includes your WaitFor call, which would work on a possibly already free'd object. This use-after-free can trigger the error above, among other even more "interesting" behaviours.
Related
I am handling some specific TForm's event [CMControlListChanging],
and need to modify that (inserted) control, but thing gets bad, when I try to do so, because apparently it's not meant to do this in the middle of VCL operation.
So I need to defer that control modification, by queuing the code away from the [CMControlListChanging] handler, to be called at later time.
Sure, I can do PostMessage stuff, but I want more general approach.
System.Classes unit contains
class procedure Synchronize(ASyncRec: PSynchronizeRecord; QueueEvent: Boolean = False); overload;
which could do the trick, but it checks, whether
CurrentThread.ThreadID = MainThreadID
and if yes, then call method I try to queue immediately.
Is the any good approach to deferred calls, at least on the main thread?
Not sure if this is what you are looking for, but if you are on a recent Delphi version these Postpone methods may come in handy. They execute AProc in the main thread after applying an optional non-blocking delay.
uses
System.Threading,
System.Classes;
procedure Postpone(AProc: TThreadProcedure; ADelayMS: Cardinal = 0); overload;
begin
TTask.Run(
procedure
begin
if ADelayMS > 0 then begin
TThread.Sleep(ADelayMS);
end;
TThread.Queue(nil, AProc);
end);
end;
procedure Postpone(AProc: TThreadMethod; ADelayMS: Cardinal = 0); overload;
begin
TTask.Run(
procedure
begin
if ADelayMS > 0 then begin
TThread.Sleep(ADelayMS);
end;
TThread.Queue(nil, AProc);
end);
end;
How about this one? It doesn't create a new task, just a new HWND (to receive the message):
TYPE TDelayedProc = REFERENCE TO PROCEDURE;
TYPE
TPostponeClass = CLASS(TWinControl)
CONSTRUCTOR Create(P : TDelayedProc);
STRICT PRIVATE
Proc : TDelayedProc;
PROCEDURE Run(VAR M : TMessage); MESSAGE WM_USER;
END;
CONSTRUCTOR TPostponeClass.Create(P : TDelayedProc);
BEGIN
INHERITED Create(NIL);
Parent:=Application.MainForm;
Proc:=P;
PostMessage(Handle,WM_USER,0,0)
END;
PROCEDURE TPostponeClass.Run(VAR M : TMessage);
BEGIN
Proc;
Free
END;
PROCEDURE Postpone(Proc : TDelayedProc);
BEGIN
TPostponeClass.Create(Proc)
END;
It even works with anonymous methods, so you can postpone a part of execution of an event and still have access to the local variables (and the instance "Self").
Use it like this:
PROCEDURE WriteFile(CONST F : TFileName ; CONST STR : STRING);
VAR
TXT : TextFile;
BEGIN
AssignFile(TXT,F);
IF FileExists(F) THEN APPEND(TXT) ELSE REWRITE(TXT);
WRITELN(TXT,STR);
CloseFile(TXT)
END;
PROCEDURE TForm37.Button1Click(Sender: TObject);
CONST
N = 'LOGFILE.TXT';
VAR
LocalVar : INTEGER;
BEGIN
DeleteFile(N);
LocalVar:=20;
Postpone(PROCEDURE
BEGIN
WriteFile(N,'Postponed Code: '+Name+' ('+IntToStr(LocalVar)+')')
END);
WriteFile(N,'Last statement in event: '+Name)
END;
The LOGFILE.TXT file will contain the two lines:
Last statement in event: Form37
Postponed Code: Form37 (20)
to illustrate that the postponed event is only run at the end of the event, as well as access to local variables.
Caveat: Do you run Application.ProcessMessages between Postpone call and event exit - if you do, the postponed code will be run at that point.
Since Delphi 10.2 Tokyo, it is possible to defer a call from the main thread asynchronously using a method of TThread.
See TThread.ForceQueue:
class procedure ForceQueue(const AThread: TThread; const AMethod: TThreadMethod); overload; static;
class procedure ForceQueue(const AThread: TThread; const AThreadProc: TThreadProcedure); overload; static;
Queues the execution of a method call within the main thread.
Unlike Queue, the execution of the method call specified by AMethod is forced to be queued although it is called by the main thread.
AMethod associates the caller thread:
For static methods, you can associate the AMethod with any thread using the AThread parameter.
You can use nil/NULL as the AThread parameter if you do not need to know the information of the caller thread in the main thread.
RemoveQueuedEvents uses this thread information to find the proper queued method.
I have some codes here:
procedure TForm1.Button1Click(Sender: TObject);
begin
//Some Codes(1)
Sample;
//Some Codes(2)
end;
Function Sample();
begin
sleep(5000);
end;
In this code, after //Somecodes(1) Application goes to Sample function and waits for 5 seconds then it runs //Somecodes(2) right? It means for Unfreezing Button1 we have to wait for more than 5 Seconds.
Now I want to do something that when the application runs //Some Codes(1) and Sample, Immediately goes to the next line (//Somecodes(2)) so I don't need to wait for 5 seconds to button 1 Unfreez.
How can I do it?
Like Andreas said, you can use threads for this. You might use them with an anonymous procedure like this: (Note: TThread.CreateAnonymousThread appears not to exist yet in Delphi 2010. I address this problem below.)
procedure TForm1.Button1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(
procedure
begin
// Chunk of code 1
Sleep(5000);
MessageBox(0, 'x', 'x', MB_OK);
end).Start;
TThread.CreateAnonymousThread(
procedure
begin
// Chunk of code 2
Sleep(5000);
MessageBox(0, 'y', 'y', MB_OK);
end).Start;
end;
You can also implement your own thread class, but using CreateAnonymousThread you can just pass a procedure that is executed in the thread. You can call Start (or Run) to run the thread immediately, and threads created using CreateAnonymousThread free themselves when they are done.
So, both chunks of code will run simultaneously. That means that after 5 seconds you will get two popups right after each other (you can drag aside the topmost to see the other). Also, the button will be responsive directly after it is clicked, while the sleeps are running in the background.
Note though that most of the VCL is not thread safe, so you should be careful not to modify (visual) components in these threads.
about thread safety
Like J... mentioned in the comments, it's not just the VCL that is not thread safe. Many code is not, and also your own code needs to be aware of this.
For instance if I modify the code above slightly, I can let both threads count to a billion and increment a shared integer. You'd expect the integer to reach 2 billion by the time the threads are done, but in my test it reaches just over one billion. That is because both threads are updating the same integer at the same time, overwriting the attempt of the other thread.
procedure TForm6.FormCreate(Sender: TObject);
var
n: Integer;
begin
n := 0;
TThread.CreateAnonymousThread(
procedure
var i: Integer;
begin
for i := 0 to 1000000000 do
Inc(n);
MessageBox(0, 'x', 'x', MB_OK);
end).Start;
TThread.CreateAnonymousThread(
procedure
var i: Integer;
begin
for i := 0 to 1000000000 do
Inc(n);
MessageBox(0, 'y', 'y', MB_OK);
end).Start;
Sleep(10000); // Make sure this is long enough. The number should appear later than 'x' and 'y'.
ShowMessage(IntToStr(n));
end;
To fix this, you can either synchronize the updating (execute it in the main thread), or use critical sections to lock the updates. In cases where you are actually just updating in integer, you can also use the InterlockedIncrement function. I will not explain these further, because there's plenty of proper documentation and it's beyond the scope of this answer.
Note though, that each of these methods slows down your application by executing the pieces of code after each other instead of simultaneously. You are effectively making the threads wait for each other. Nevertheless, threads are still useful, if you can finetune them so that only small pieces need to be synchronised.
TThread.CreateAnonymousThread in Delphi 2010
TThread.CreateAnonymousThread just creates an instance of TAnonymousThread, a specific thread class that executes a given procedure.
Since TThread.CreateAnonymousThread doesn't exist in Delphi 2010, you can just call it like this:
TAnonymousThread.Create(
procedure
var i: Integer;
begin
for i := 0 to 1000000000 do
Inc(n);
MessageBox(0, 'x', 'x', MB_OK);
end).Start;
I don't know if TAnonymousThread itself does exist in Delphi 2010, but if not, you can find it's code below. I hope Embarcadero doesn't mind me sharing it, but it's actually just four simple lines of code.
This class you could just as easy create yourself, but it is declared like below. The constructor takes a single parameter, which is the procedure to execute. It also sets a property that makes the thread free itself when done. The execute method just executes the given procedure.
type
TAnonymousThread = class(TThread)
private
FProc: TProc;
protected
procedure Execute; override;
public
constructor Create(const AProc: TProc);
end;
constructor TAnonymousThread.Create(const AProc: TProc);
begin
inherited Create(True);
FreeOnTerminate := True;
FProc := AProc;
end;
procedure TAnonymousThread.Execute;
begin
FProc();
end;
Consider the following program:
program TThreadBug;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, Windows;
type
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
procedure TMyThread.Execute;
var
i: Integer;
begin
for i := 1 to 5 do begin
Writeln(i);
Sleep(100);
end;
end;
procedure UseTThread;
var
Thread: TMyThread;
begin
Writeln('TThread');
Thread := TMyThread.Create;
Thread.Terminate;
Thread.WaitFor;
Thread.Free;
Writeln('Finished');
Writeln;
end;
procedure UseTThreadWithSleep;
var
Thread: TMyThread;
begin
Writeln('TThreadWithSleep');
Thread := TMyThread.Create;
Sleep(100);
Thread.Terminate;
Thread.WaitFor;
Thread.Free;
Writeln('Finished');
Writeln;
end;
begin
UseTThread;
UseTThreadWithSleep;
Readln;
end.
The output is:
TThread
Finished
TThreadWithSleep
1
2
3
4
5
Finished
So it seems that, for some reason, the main thread has to wait some arbitrary amount of time before terminating and waiting for the worker thread. Am I right in thinking that this is a bug in TThread? Is there any way I can work around this? I expect that if I get my thread to signal that it has started (using an event), then that would work around the issue. But that makes me feel dirty.
You can call it a bug or a TThread design flaw, the problem was discussed many times. See for example http://sergworks.wordpress.com/2011/06/25/sleep-sort-and-tthread-corner-case/
The problem is that if TThread.Terminated flag is set too early TThread.Execute method is never called. So in your case just don't call TThread.Terminate before TThread.WaitFor.
I think the reason why this happens, has been sufficiently answered by Serg's answer, but I think you should not normally call Thread.Terminate anyway. The only reason to call it, if you want the thread to terminate, for instance when the application is closing.
If you just want to wait until it is finished, you can call WaitFor (or WaitForSingleObject). This is possible, because the handle for the thread is already created in its constructor, so you can call it right away.
Also, I set FreeOnTerminate to true on these threads. Just let them run and free themselves. If I want a notification of them to be done, I can use either WaitFor or the OnTerminate event.
Here's just an example of a bunch of worker threads emptying a queue in a blocking way.
I would think you shouldn't need this, David, but maybe someone else may be happy with an example. On the other hand, you probably didn't ask this question just to have a change to rant about TThread's poor implementation, right? ;-)
First the Queue class. It's not really a traditional queue, I think. In a real multi-threaded queue, you should be able to add to the queue at any point, even when the processing is active. This queue requires you to fill its items upfront, then call the -blocking- run method. Also, the processed items are saved back to the queue.
type
TQueue = class
strict private
FNextItem: Integer;
FRunningThreads: Integer;
FLock: TCriticalSection;
FItems: TStrings; // Property...
private
// Signal from the thread that it is started or stopped.
// Used just for indication, no real functionality depends on this.
procedure ThreadStarted;
procedure ThreadEnded;
// Pull the next item from the queue.
function Pull(out Item: Integer; out Value: string): Boolean;
// Save the modified value back in the queue.
procedure Save(Item: Integer; Value: string);
public
property Items: TStrings read FItems;
constructor Create;
destructor Destroy; override;
// Process the queue. Blocking: Doesn't return until every item in the
// queue is processed.
procedure Run(ThreadCount: Integer);
// Statistics for polling.
property Item: Integer read FNextItem;
property RunningThreads: Integer read FRunningThreads;
end;
Then the Consumer thread. That one is plain and easy. It just has a reference to the queue, and an execute method that runs until the queue is empty.
TConsumer = class(TThread)
strict private
FQueue: TQueue;
protected
procedure Execute; override;
public
constructor Create(AQueue: TQueue);
end;
Here you see the implementation of this obscure 'Queue'. It's main methods are Pull and Save, which are used by the Consumer to pull the next item, and save the processed value back.
Another important method is Run, which starts a given number of worker threads and waits until all of them are finished. So this is actually a blocking method, which only returns after the queue is emptied. I'm using WaitForMultipleObjects here, which allows you to wait for upto 64 threads before you need to add extra tricks. It's the same as using WaitForSingleObject in the code in your question.
See how Thread.Terminate is never called?
{ TQueue }
constructor TQueue.Create;
// Context: Main thread
begin
FItems := TStringList.Create;
FLock := TCriticalSection.Create;
end;
destructor TQueue.Destroy;
// Context: Main thread
begin
FLock.Free;
FItems.Free;
inherited;
end;
function TQueue.Pull(out Item: Integer; out Value: string): Boolean;
// Context: Consumer thread
begin
FLock.Acquire;
try
Result := FNextItem < FItems.Count;
if Result then
begin
Item := FNextItem;
Inc(FNextItem);
Value := FItems[Item];
end;
finally
FLock.Release;
end;
end;
procedure TQueue.Save(Item: Integer; Value: string);
// Context: Consumer thread
begin
FLock.Acquire;
try
FItems[Item] := Value;
finally
FLock.Release;
end;
end;
procedure TQueue.Run(ThreadCount: Integer);
// Context: Calling thread (TQueueBackgroundThread, or can be main thread)
var
i: Integer;
Threads: TWOHandleArray;
begin
if ThreadCount <= 0 then
raise Exception.Create('You no make sense no');
if ThreadCount > MAXIMUM_WAIT_OBJECTS then
raise Exception.CreateFmt('Max number of threads: %d', [MAXIMUM_WAIT_OBJECTS]);
for i := 0 to ThreadCount - 1 do
Threads[i] := TConsumer.Create(Self).Handle;
WaitForMultipleObjects(ThreadCount, #Threads, True, INFINITE);
end;
procedure TQueue.ThreadEnded;
begin
InterlockedDecrement(FRunningThreads);
end;
procedure TQueue.ThreadStarted;
begin
InterlockedIncrement(FRunningThreads);
end;
The code for the consumer thread is plain and easy. It signals its start and end, but that's just cosmetic, because I want to be able to show the number of running threads, which is at it's max as soon as all threads are created, and only starts declining after the first thread exits (that is, when the last batch of items from the queue are being processed).
{ TConsumer }
constructor TConsumer.Create(AQueue: TQueue);
// Context: calling thread.
begin
inherited Create(False);
FQueue := AQueue;
// A consumer thread frees itself when the queue is emptied.
FreeOnTerminate := True;
end;
procedure TConsumer.Execute;
// Context: This consumer thread
var
Item: Integer;
Value: String;
begin
inherited;
// Signal the queue (optional).
FQueue.ThreadStarted;
// Work until queue is empty (Pull returns false).
while FQueue.Pull(Item, Value) do
begin
// Processing can take from .5 upto 1 second.
Value := ReverseString(Value);
Sleep(Random(500) + 1000);
// Just save modified value back in queue.
FQueue.Save(Item, Value);
end;
// Signal the queue (optional).
FQueue.ThreadEnded;
end;
Of course, if you want to view the progress (or at least a little), you don't want a blocking Run method. Or, like I did, you can execute that blocking method in a separate thread:
TQueueBackgroundThread = class(TThread)
strict private
FQueue: TQueue;
FThreadCount: Integer;
protected
procedure Execute; override;
public
constructor Create(AQueue: TQueue; AThreadCount: Integer);
end;
{ TQueueBackgroundThread }
constructor TQueueBackgroundThread.Create(AQueue: TQueue; AThreadCount: Integer);
begin
inherited Create(False);
FreeOnTerminate := True;
FQueue := AQueue;
FThreadCount := AThreadCount;
end;
procedure TQueueBackgroundThread.Execute;
// Context: This thread (TQueueBackgroundThread)
begin
FQueue.Run(FThreadCount);
end;
Now, calling this from the GUI itself. I've created a form, that holds two progress bars, two memo's, a timer and a button. Memo1 is filled with random strings. Memo2 will receive the processed strings after processing is fully done. The timer is used to update the progress bars, and the button is the only thing that actually does something.
So, the form just contains all these fields, and a reference to the queue. It also contains an event handler to be notified when processing is complete:
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Timer1: TTimer;
ProgressBar1: TProgressBar;
ProgressBar2: TProgressBar;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
Q: TQueue;
procedure DoAllThreadsDone(Sender: TObject);
end;
Button1 click event, initializes the GUI, creates the queue with 100 items, and starts a background thread to process the queue. This background thread receives an OnTerminate event handler (default property for TThread) to signal the GUI when processing is done.
You can just call Q.Run in the main thread, but then it will block your GUI. If that is what you want, then you don't need this thread at all!
procedure TForm1.Button1Click(Sender: TObject);
// Context: GUI thread
const
ThreadCount = 10;
StringCount = 100;
var
i: Integer;
begin
ProgressBar1.Max := ThreadCount;
ProgressBar2.Max := StringCount;
Memo1.Text := '';
Memo2.Text := '';
for i := 1 to StringCount do
Memo1.Lines.Add(IntToHex(Random(MaxInt), 10));
Q := TQueue.Create;
Q.Items.Assign(Memo1.Lines);
with TQueueBackgroundThread.Create(Q, ThreadCount) do
begin
OnTerminate := DoAllThreadsDone;
end;
end;
The event handler for when the processing thread is done. If you want the processing to block the GUI, then you don't need this event handler and you can just copy this code to the end of Button1Click.
procedure TForm1.DoAllThreadsDone(Sender: TObject);
// Context: GUI thread
begin
Memo2.Lines.Assign(Q.Items);
FreeAndNil(Q);
ProgressBar1.Position := 0;
ProgressBar2.Position := 0;
end;
Timer is just for updating the progress bars. It fetches the number of running threads (which will only decline when processing is almost done), and it fetched the 'Item', which is actually the next item to process. So it may look finished already when actually the last 10 items are still being processed.
procedure TForm1.Timer1Timer(Sender: TObject);
// Context: GUI thread
begin
if Assigned(Q) then
begin
ProgressBar1.Position := Q.RunningThreads;
ProgressBar2.Position := Q.Item;
Caption := Format('%d, %d', [Q.RunningThreads, Q.Item]);
end;
Timer1.Interval := 20;
end;
I don't see this behavior as a bug in TThread. Execution of the new thread is supposed to occur independently of / asynchronous to the execution of the current thread. If things were set up such that the new thread was guaranteed to begin execution before TThread.Create() returns control to the caller in the current thread, that would mean execution of the new thread was (partially) synchronous to the current thread.
The new thread is added to the thread scheduling queue after the thread resources are allocated. If you're constructing a new thread from scratch (I seem to recall TThread does), this can take awhile because a lot of stuff has to be allocated behind the scenes. Avoiding this cost of getting a thread started is why ThreadPool.QueueUserWorkItem was created.
Furthermore, the behavior you're seeing fits perfectly well with the instructions you've laid out. Construct a new TThread. Immediately terminate it. Why is there any expectation that the new thread will have any opportunity to execute?
If you must have synchronous behavior around thread creation, you will at a minimum need to relinquish your remaining timeslice on the current thread. Sleep(0) will suffice. Sleep(0) gives up the rest of your current timeslice and immediately gets back into the scheduling queue behind whatever other threads (at your same priority) are waiting.
If you observe that Sleep(0) is not sufficient to getting the new thread up and running before the current thread calls Terminate, then thread creation overhead is probably preventing the new thread from getting into the thread-ready queue soon enough to satisfy your impatient current thread. In this case, try separating the overhead of thread construction from execution by constructing the new thread in the suspended state, then Start the new thread, then Sleep(0) in the current thread, then Terminate the new thread. This will give the new thread the best chance to get into the thread-ready schedule queue ahead of the current thread before the current thread terminates it.
This is as close as you're going to get to a "directed yield" in WinAPI without explicit cooperation or signaling from inside the new thread. Explicit cooperation / signalling from the new thread is the only way to guarantee that the calling thread will wait until after the new thread begins executing.
Signalling state between threads isn't dirty. What is dirty is expecting/requiring new thread construction to block the calling thread.
As already explained you must wait for the thread until it has started before calling Terminate otherwise TThread.Execute will never be called. To do so you can wait until the property TThread.Started is true.
while not Thread.Started do;
Also you can call TThread.Yield while waiting for the thread to start, because this
notifies the system that it can pass the execution to the next scheduled thread on the current processor. The operating system will select the next thread.
while not Thread.Started do
TThread.Yield;
At least we will end up with
procedure UseTThreadWithYield;
var
Thread: TMyThread;
begin
Writeln('TThreadWithYield');
Thread := TMyThread.Create;
// wait for the thread until started
while not Thread.Started do
TThread.Yield;
Thread.Terminate;
Thread.WaitFor;
Thread.Free;
Writeln('Finished');
Writeln;
end;
and a generated output like this
TThreadWithYield
1
2
3
4
5
Finished
to write information on the processing state to the GUI inside a tcpserver.onexecute(..) function , i used the following command sequence
ExecuteDUMMYCommand(Global_Send_Record);
BitMap_PaintImageProcess;
TThread.Synchronize(nil, BitMap_PaintImageProcess);
The code is working well on some machines, but on a few it fails. The code execution stops atTThread.Synchronize command. I guess on these machines the function call is trapped inside a deadlock
Any chance to figure out the real problem behind ?
The procedure BitMap_PaintImageProcess , here I create a Bitmap and do a lot of painting stuff , but is seems that this code is never executed ?
I try to explain the very long code and reduce to the main points , the critical thread issues are hidden in processing the bitmap inside my Bitmapprocessingclass.
This class is accessed inside the GUIProcessing procedures of my ServerMainForm which also has the INDY TCP Server component.
{--------------- CLASS DEFINITION -----------------------------}
TBitMapProcessingClass = class()
FBitmap : TBitmap;
FList : TListOfSomething;
procedure ProcessTheBitmap(....);
......
(many many functions);
procedure Init;
procedure Free;
Procedure Create;
end;
TMainform = class(TForm)
MyServer : TIdTCPServer;
aBitMaoProcessingClass : TBitMaoProcessingClass;
procedure BitMap_PaintImageProcess;
procedure BitMap_ListProcess;
.....
end;
{------------------------- Implemantation ------------------------------}
procedure TMainform.IndyTCPServer.Onexecute()
begin
.......
ExecuteDUMMYCommand(Global_Send_Record);
BitMap_PaintImageProcess;
TThread.Synchronize(nil, BitMap_PaintImageProcess);
.......
end;
procedure TMainform.BitMap_PaintImageProcess;
begin
DoSomeServerVCLStuff(....);
aBitMapProcessingClass.ProcessTheBitmap;
DoSomeServerVCLStuff(....);
end;
Having no idea what BitMap_PaintImageProcess() does in fact, I have a few suppositions:
In the TThread.Synchronize call you try to read some data from the socket/idContext, but the data is not yet available. This will block the main thread until the data becomes available. But Indy's thread that is responsible for reading from the underlying socket buffer is currently blocked by your TThread.Synchronize call in the OnExecute event i.e. deadlock occurs;
In the TThread.Synchronize call you use Application.ProcessMessages (a common mistake);
In the OnExecute event you enter a critical section. Then during the TThread.Synchronize call you try to enter the same critical section again;
You modify the GUI in the onExecute event. Because onExecute is not thread safe, accessing VCL/FM from Indy's thread could lead to unpredictable results, including random deadlocks (hard to find).
I would suggest to use MadExcept / Eurekalog. They both have options to check if the main thread is "frozen". When that happens (during the deadlock) they will show you the current call stack. Having the call stack you can figure out which function is causing the deadlock.
Regarding the posted code:
procedure TMainform.IndyTCPServer.Onexecute()
begin
.......
ExecuteDUMMYCommand(Global_Send_Record);
BitMap_PaintImageProcess; //-> You do VCL stuff in the context of Indy's thread!
TThread.Synchronize(nil, BitMap_PaintImageProcess);
end;
In the BitMap_PaintImageProcess() you call DoSomeServerVCLStuff(....). Do not forget that OnExecute is fired from Indy's thread for the current context. I.e. you modify VCL from another thread (other from the Main Thread) which is not thread safe.
On your comment:
...but here my complex TBitmap processing Class must be alive the whole
time my Server is active...
If you have only one (global) instance for image processing, then what will happen if another client connects, while you are still processing the old connection (think Parallel :) )? Your image processing class should be instantiated separately for each new connection/context. For GUI updating you can use TIdNotify descendant.
A possible solution:
type
{ tIdNotify Stuff }
TVclProc= procedure(imgClass: tMyImageProcessingClass) of object;
tIdNotifyDescendant = (tIdNotify)
protected
fImgClass: tMyImageProcessingClass;
fProc: TVclProc;
procedure DoNotify; override;
public
class procedure updateVcl(imgClass: tMyImageProcessingClass; vclProc: TVclProc);
end;
procedure tIdNotifyDescendant.DoNotify;
begin
inherited DoNotify;
FProc(fImgClass);
end;
class procedure tIdNotifyDescendant.updateVcl(imgClass: tMyImageProcessingClass; vclProc: TVclProc);
begin
with Create do
begin
fImgClass := imgClass;
fProc := vclProc;
Notify;
end;
end;
{ Indy stuff & other logic }
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
// Create your instance when the client connects
AContext.Data := tMyImageProcessingClass.Create;
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
// Do cleanup
if assinged(AContext.Data) then
(AContext.Data as tMyImageProcessingClass).Free // Casting just for clarity
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
imgProcClass: tMyImageProcessingClass;
begin
imgProcClass := acontext.Data as tMyImageProcessingClass;
// Do image processing
// Notify GUI for the progress:
tIdNotifyDescendant.updateVcl(AContext.data as tMyImageProcessingClass);
end;
Tip: If you do JPEG processing and you use Draw() method have in mind this: TJPEGImage.Draw() is not thread safe
I added a few more details on my BitmapProcessingclass and the idea of a thread safe extension of the existing class...
I need the existing class u nchanged in others apps ... I need a extension inside my app with the indy server.
ONly one client my connect to one server, or he has to query the state of the server
type TBmpNotify = class(TIdNotify)
protected
FBMP: MyImageProcessingClass;
procedure DoNotify; override;
public
constructor Create(aBMP: MyImageProcessingClass);
function SetImageView(LL, UR: TPoint): Boolean;
procedure PaintBitMap;
function InitBitMap(x, y: Integer;
PixelFormat: TPixelFormat = pf24bit): Boolean;
destructor free;
end;
implementation
{ TBmpNotify }
constructor TBmpNotify.Create(aBMP: MyImageProcessingClass);
begin
// indise this class I also create
// class.TBitmap
// class.TList
// much more stuff ....
FBmp := MyImageProcessingClass.Create;
end;
procedure TBmpNotify.DoNotify;
begin
inherited;
end;
destructor TBmpNotify.free;
begin
FBmp.Free;
inherited;
end;
function TBmpNotify.InitBitMap(x, y: Integer;
PixelFormat: TPixelFormat): Boolean;
begin
// Write values to the List
// also modify TBitmap
// execution time of this function ~ 5 min
FBmp.InitBitMap(x,y,PixelFormat)
end;
procedure TBmpNotify.PaintBitMap;
begin
// much TBitmap, bitmap.canvas .... is used
// execution time of this function ~ 1 min
FBmp.PaintBitMap;
end;
function TBmpNotify.SetImageView(LL, UR: TPoint): Boolean;
begin
// this function takes about 1 min
FBmp.SetImageView(LL, UR);
end;
end.
I want to make a TCPserver and send/receive message to clients as needed, not OnExecute event of the TCPserver.
Send/receive message is not a problem; I do like that:
procedure TFormMain.SendMessage(IP, Msg: string);
var
I: Integer;
begin
with TCPServer.Contexts.LockList do
try
for I := 0 to Count-1 do
if TIdContext(Items[I]).Connection.Socket.Binding.PeerIP = IP then
begin
TIdContext(Items[I]).Connection.IOHandler.WriteBuffer(Msg[1], Length(Msg));
// and/or Read
Break;
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
Note 1: If I don't use OnExecute, the program raise an exception when a client connects.
Note 2: If I use OnExecute without doing anything, the CPU usage goes to %100
Note 3: I don't have a chance to change the TCP clients.
So what should I do?
TIdTCPServer requires an OnExecute event handler assigned by default. To get around that, you would have to derive a new class from TIdTCPServer and override its virtual CheckOkToBeActive() method, and should also override the virtual DoExecute() to call Sleep(). Otherwise, just assign an event handler and have it call Sleep().
This is not an effective use of TIdTCPServer, though. A better design is to not write your outbound data to clients from inside of your SendMessage() method directly. Not only is that error-prone (you are not catching exceptions from WriteBuffer()) and blocks SendMessage() during writing, but it also serializes your communications (client 2 cannot receive data until client 1 does first). A much more effective design is to give each client its own thread-safe outbound queue, and then have SendMessage() put the data into each client's queue as needed. You can then use the OnExecute event to check each client's queue and do the actual writing. This way, SendMessage() does not get blocked anymore, is less error-prone, and clients can be written to in parallel (like they should be).
Try something like this:
uses
..., IdThreadSafe;
type
TMyContext = class(TIdServerContext)
private
FQueue: TIdThreadSafeStringList;
FEvent: TEvent;
public
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
destructor Destroy; override;
procedure AddMsgToQueue(const Msg: String);
function GetQueuedMsgs: TStrings;
end;
constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
inherited;
FQueue := TIdThreadSafeStringList.Create;
FEvent := TEvent.Create(nil, True, False, '');
end;
destructor TMyContext.Destroy;
begin
FQueue.Free;
FEvent.Free;
inherited;
end;
procedure TMyContext.AddMsgToQueue(const Msg: String);
begin
with FQueue.Lock do
try
Add(Msg);
FEvent.SetEvent;
finally
FQueue.Unlock;
end;
end;
function TMyContext.GetQueuedMsgs: TStrings;
var
List: TStringList;
begin
Result := nil;
if FEvent.WaitFor(1000) <> wrSignaled then Exit;
List := FQueue.Lock;
try
if List.Count > 0 then
begin
Result := TStringList.Create;
try
Result.Assign(List);
List.Clear;
except
Result.Free;
raise;
end;
end;
FEvent.ResetEvent;
finally
FQueue.Unlock;
end;
end;
procedure TFormMain.FormCreate(Sender: TObject);
begin
TCPServer.ContextClass := TMyContext;
end;
procedure TFormMain.TCPServerExecute(AContext: TIdContext);
var
List: TStrings;
I: Integer;
begin
List := TMyContext(AContext).GetQueuedMsgs;
if List = nil then Exit;
try
for I := 0 to List.Count-1 do
AContext.Connection.IOHandler.Write(List[I]);
finally
List.Free;
end;
end;
procedure TFormMain.SendMessage(const IP, Msg: string);
var
I: Integer;
begin
with TCPServer.Contexts.LockList do
try
for I := 0 to Count-1 do
begin
with TMyContext(Items[I]) do
begin
if Binding.PeerIP = IP then
begin
AddMsgToQueue(Msg);
Break;
end;
end;
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
Use OnExecute and if you have nothing to do, Sleep() for a period of time, say 10 milliseconds. Each connection has its own OnExecute handler so this will only affect each individual connection.
In the OnExecute handler, you can use thread communication methods like TEvent and TMonitor to wait until there is data for the client.
TMonitor is available since Delphi 2009 and provides methods (Wait, Pulse and PulseAll) to send / receive notifications with mininmal CPU usage.
The Indy component set is designed to emulate blocking operation on a network connection. You're supposed to encapsulate all your code in the OnExecute event handler. That's supposed to be easier, because most protocols are blocking any way (send command, wait for response, etc).
You apparently don't like it's mode of operation, you'd like something that works without blocking. You should consider using a component suite that's designed for the way you intend to use it: give the ICS suite a try! ICS doesn't use threads, all the work is done in event handlers.
I had similar situation taking 100% CPU and it solved by adding IdThreadComponent and:
void __fastcall TForm3::IdThreadComponent1Run(TIdThreadComponent *Sender)
{
Sleep(10);
}
Is it right? I am not sure.