Delphi not all threads executing simultaneously - multithreading

I have the following scenario:
The program I am writing simulates multiple air networks. Now I have written it so that each simulation is in its own thread with its own data. This is so that there can be no contamination of data and each thread is complete multitasking safe. I have implemented delphi's native TThread class for each thread.
The program has one main thread. It then creates multiple sub threads for each network (my current test case has 6). But each sub thread also has 4 additional threads since its network has more than one layout. So in total I have 31 threads, but only 24 threads actively processing. All threads are created in suspended mode so that I can manually start them.
The computer I am running on is an i5 laptop so it has 4 threads (2 physical cores + 2 HT). In the production environment this will run on servers so they will have more processing power.
Now in the main program thread I have added a break point after the for loop which executes the threads. This doesn't trigger immediately. Watching the debug console of Delphi, it looks like it is only actively running 4 threads at a time. As soon as one exits, it starts another thread.
The simulations in the threads are difficult to optimize and require a few loops to finish the simulation. And each loop requires the previous loop's data. But each simulation is completely independent of the next so the program is an excellent candidate for threads and pipe lining.
Now my question is why does it only start 4 threads and not all the threads as the code specifies?
EDIT Added pieces of code
Main program
for i := 0 to length(Solutions)-1 do
begin
Solutions[i].CreateWorkers; //Setup threads
end;
for i := 0 to length(Solutions)-1 do
begin
Solutions[i].Execute; //start threads
end;
end;
isSolversBusy := false; //breaking point doesn't trigger here
1St level of threads
procedure cSolution.Execute;
var
i : integer;
lIsWorkerStillBusy : boolean;
begin
lIsWorkerStillBusy := true;
for i := 0 to length(Workers)-1 do
begin
Workers[i].Start;
end;
while (lIsWorkerStillBusy) do
begin
lIsWorkerStillBusy := false;
for i := 0 to length(Workers)-1 do
begin
if Workers[i].IsCalculated = false then
begin
lIsWorkerStillBusy := true;
end;
end;
sleep(100);
end;
FindBestNetwork;
IsAllWorkersDone := true;
end;
2nd level of threads
procedure cWorker.Execute;
begin
IsCalculated := false;
Network.UpdateFlows;
Network.SolveNetWork; //main simulation work
CalculateTotalPower;
IsCalculated := true;
end;
EDIT 2
The reason I create them all suspended is because I store them in an array and before I start them I first have create the workers and their properties. I am simulating air network scenarios. Each solution is a different layout, while each worker is a different way of running that layout.
I have to first calculate all the worker's start properties before I start them all. In hind sight I could modify the code to do that in the thread. It currently happens in the main thread. The creation of the threads happens before the piece of code I pasted here.
The reason I keep them all in threads is that I need to evaluate the results of each thread afterwords.

This is your problem :
for i := 0 to length(Solutions)-1 do
begin
Solutions[i].Execute; //start threads
end;
This does not start the threads - this is executing the Execute method in the calling thread. In fact you were not running only 4 threads at a time, you were not even running one - all of this work would be done on the main thread sequentially. To resume a suspended thread you must use Solutions[i].Start.
The Execute method of a TThread is a special method that is executed on the worker thread created by the TThread automatically. When you create a TThread this method is automatically run on the worker thread that the TThread creates. If you create the thread suspended then it simply waits for you to wake the thread before beginning this work. Calling the .Start method of a TThread is what accomplishes this - triggering the underlying worker thread to begin executing the .Execute method.
Otherwise, the Execute method, and all other methods of a TThread are no different from any other normal method belonging to a class. They can be executed on any thread that calls them directly.
In this case, it doesn't seem like you are doing any additional work in the main thread between creating and executing your workers. In this case, unless you have an explicit need for it, you could simply create your threads not-suspended and let them execute automatically upon creation.

Related

Delphi 10: Correct way to run tasks simultaneously

I'm trying to learn how to use delphi parallel library instead of TThread. I have many tasks that I want to run simultaneously. Each task is most time waiting for some event, while its waiting, I'd like to pass excecution to another tasks.
Here is my sample code:
type
TObj = class
pos: integer;
Done: boolean;
Constructor Create;
procedure DoWork(Sender: TObject);
end;
var
Objects : array [0..39] of TObj;
tasks : array of ITask;
constructor TObj.Create;
begin
pos:=0;
DOne:=false;
end;
procedure TObj.DoWork(Sender: TObject);
begin
repeat
inc(pos);
sleep(100);
until Done;
end;
procedure TForm1.StartClick(Sender: TObject);
var
i: integer;
begin
Setlength (tasks ,Length(Objects));
for i:=0 to Length(tasks)-1 do begin
Objects[i]:=TObj.Create;
tasks[i] := TTask.Create(Objects[i],Objects[i].DoWork);
tasks[i].Start;
end;
sleep(5000);
Memo1.Lines.Clear;
for i:=0 to Length(tasks)-1 do begin
Objects[i].Done:=true;
Memo1.Lines.Add(IntToStr(Objects[i].pos));
end;
end;
I start N Tasks, each should increase its counter by 1 in 100ms. Then I wait 5 sec and check task's values. I excpect them to be at least nearly equal, but real Memo1's output shows first 12 values are about 50, the other 4 values about 20-30 (I'm running Ryzen 1600), and whats strange fo me that the least values are all 0!
Evidently only 16 tasks from 40 actually excecuted atleast once in 5 seconds, so I would like to know how I can replace sleep(100) to actually pass excecution to another tasks?
Just because you start N number of tasks does not mean that N number of tasks will be running concurrently. If you want that, stick with TThread.
The PPL uses an internal thread pool to service the TTask objects, and that pool is self-throttling and self-adjusting based on now many CPUs you have installed and how many tasks are actually running. This is explained in the PPL documentation:
The RTL provides the Parallel Programming Library (PPL), giving your applications the ability to have tasks running in parallel taking advantage of working across multiple CPU devices and computers. The PPL includes a number of advanced features for running tasks, joining tasks, waiting on groups of tasks, etc. to process. For all this, there is a thread pool that self tunes itself automatically (based on the load on the CPU’s) so you do not have to care about creating or managing threads for this purpose.
If you create more tasks than the pool has threads, some tasks are going to be waiting for earlier tasks to finish their work. When a given thread finishes a task, it checks for a waiting task, and if found then runs it, repeating until there are no more tasks to run. Multiply that by the number of threads in the pool and the number of tasks in the queue.
So, there will only ever be a handful of tasks running at any given time, and so it may take awhile to get through all of the tasks that you queue up.
If you want more control over the thread pooling, you have to create a TThreadPool object, set its MinWorkerThreads and MaxWorkerThreads properties as desired, and then pass that object to one of the TTask constructors that has an APool input parameter. By default, the MinWorkerThreads is set to TThread.ProcessorCount, and the MaxWorkerThreads is set to TThread.ProcessorCount * 25.

how to get count for terminated threads?

hello friends i have a doubt regarding thread count. i have some code written below for thread
Procedure Mainthread.execute;
var
I : integer;
ScannerCh : array of ScannerChild; //array of ScannerChild
IpList : TStringlist;
IPs: Integer; //ipcount is count of iplist
Begin
IpList:=TStringList.Create;//creating stringlist
IPs := IpList.Count; //Ipcount is given value of iplists count
SetLength(ScannerCh, IPs); //Setting length of scannerch as ipcount
I:=0;
Repeat
While getthreadscount(getcurrentprocessid) >= tcount + 1(for main thread + Scannerch threads) do //Checking if is greater than tcount(thread input) by user
Sleep(30);
ScannerCh[I]:=ScannerChild.Create(True, IpList[i]);
ScannerCh[I].FreeOnTerminate:=True;
ScannerCh[I].LvHostname := LvHosts;
ScannerCh[I].Resume;
I:=I+1;
Sleep(20); //Sleep after each thread is created so that threads will enter critical section properly
until I = IPs;
end;
Scannerchild thread does some work. my code works perfectly if i have only these threads in process. If there are some other threads running to then i will be in trouble getting threadscount by getthreadscount function and i will not get to know which threads are getting terminated by getthreadcount function. so how can i enhance my code for many threads working. My logic is when scannerch thread terminates it should decrement count variable and when it gets created it should increment count variable. so that it will not be any problem if other threads are terminated or not. i just want to deal with scannerch thread termination and need to get counts of instances of running threads of scannerch. so that i put count variable instead of getthreadscount and my problem will be solved
Well, the question is easy enough to answer. Declare a count variable in the main thread class:
FScannerChildCount: Integer;
Whenever you create a new thread, increment this variable. Whenever a thread terminates, decrement it.
The incrementing is easy to do since you create the threads quite clearly and explicitly in the main thread code.
As for the decrementing, you need an OnTerminate event handler for each scanner child thread instance. This executes in the context of the process main thread, rather than your MainThread thread. FWIW, MainThread is a terrible name since everyone takes main thread to mean the main process thread. Because the OnTerminate event doesn't run in the same thread as your MainThread thread, you'll need synchronization.
When you increment the thread, use InterlockedIncrement. And when you decrement, use InterlockedDecrement.
The OnTerminate handler might look like this:
procedure MainThread.ScannerChildTerminate(Sender: TObject);
begin
InterlockedDecrement(FScannerChildCount);
end;
And you assign the event like any other event handler:
ScannerCh[I] := ...;
....
ScannerCh[I].OnTerminate := ScannerChildTerminate;
....
ScannerCh[I].Resume;
All of this said, whilst this may be the answer to the question you asked, you are attempting to solve your problem the wrong way. You should be using a thread pool to simplify the coding and avoid the overhead of creating and destroying short lived threads.

Thread Pool Class developement [closed]

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 8 years ago.
Improve this question
I run a multithread application and I want to limit the number of threads on my machine
The code concept goes currently like this (it is just a drft to show the major ideas behind)
// a List with all the threads I have
class MyTHreadList = List<TMyCalcThread>;
// a pool class, check how many threads are active
// try to start additions threads once the nr. of running THreads
// is below the max_thread_value_running
class MyTheardPool = Class
ThreadList : MyTHreadList;
StillRunningTHreads : Integer;
StartFromThreadID : Integer;
end;
var aTHreadList : MyTHreadList;
procedure MainForm.CallCreateThreadFunction( < THREAD PARAMS > );
begin
// just create but do not start here
MyTHread := TMyCalcThread.create ( < THREAD PARAMS > );
MyTHread.Onterminate := What_To_do;
// add all threads to a list
aTHreadList.add(MyTHread);
end;
/// (A)
procedure MainForm.What_To_do ()
var start : Integer;
begin
max_thread_value_running := max_thread_value_running -1;
if max_thread_value_running < max_thread_count then
begin
start := max_thread_count - max_thread_value_running;
startThereads(start,StartFromThreadID)
end;
end;
procedure MainForm.startThereads (HowMany , FromIndex : Integer);
var i : INteger;
begin
for I := FromIndex to HowMany + FromIndexdo
begin
// thread[i].start
end;
end;
MainForm.Button ();
/// main VCL form , create threats
for i := 0 to allTHreads do
begin
CallCreateTHreadFunction( < THREAD PARAMS > );
end;
......
/// (B)
while StillRunningTHreads > 0 do
begin
Application.processmessages;
end;
The complete idea is a small list with the Threads, on every individual Thread terminate step I update the number of running threads and start the now possible max. number of new threads.(A) Instead of a Function WaitforSingleObject () .... I do a loop at the end to wait for all threads to finish execution. (B)
From the code design I did not find any full example on the net, I may approach a vaild design or will I run into some trouble which I did not consider right now.
Any comment on the diesign or a better class design is welcome.
Don't try to micro-manage threads like this. Just don't. Either use the Win API threadpool calls, or make your own threadpool from a producer-consumer queue and TThread instances.
When a task is completed, I suggest that the work thread call an 'OnCompletion' TNotifyEvent of the task class with the task as the parameter. Ths can be set by the issuer of the task to anything they might wish, eg. postMessaging the task instance to the GUI thread for display.
Micro-managing threads, continually creating/waiting/terminating/destroying, Application.processmessages loops etc. is just horrible and almost sure to go wrong at some point.
Waiting for ANYTHING in a GUI event-handler is just bad. The GUI system is a state-machine and you should not wait inside it. If you want to issue a task from the GUI thread, do so but don't wait for it - fire it off and forget it until it is completed and gets posted back to a message-handler procedure.
Basically thread-pools are a nice feature (There is an implementation in the Win32 API, however I don't have any experience with it).
There is one basic stumble stone however: You need to remember that a task may be delayed until an empty thread is available. If you need synchronization between different tasks (e.g. tasks are waiting on other tasks) then you have a serious deadlock problem:
Just assume that all running tasks wait for a single task which is waiting for a free thread...
A similar problem can also happen if your threads wait for the main thread to react while the main thread waits for a new task to start.
If your tasks don't need any further synchronization (e.g. once a task is finished it will just mark itself as finished and the main thread will then later on read the result) you don't need to worry about this.
As a small side note:
I would use two separate lists: One for free (suspended) threads and one for running threads.
I'd consider to use an existing Thread-Pool implementation (like Winapi CreateThreadpool) before I created my own...
The loop (B) takes away a lot of CPU power from the threads. Don't wait actively in a loop for threads, use one of the WaitFor.... functions.
Reuse your threads and have a list of "todos" that the threads will execute. Thread creation and destruction can be expensive.
Apart from that I'd recommend that you use an existing library instead of reinventing the wheel. Or use at least the Windows API thread pool functions.

When does background threads prevent the process of being terminated?

Our program creates a background thread at the beginning of the program. The background thread does some database integrity checks and checks for stuff in the Internet using Indy. After 10 seconds, the background thread should be finished and since FreeOnTerminate is true, it will also clean itself up.
We have noticed that in some cases, if the user closes the program too quickly, the process will still be alive until the background thread is finished.
Since we couldn't exactly reproduce the issue, I have created a demo project to try a few things:
type
TBackgroundThread = class(TThread)
protected
procedure Execute; override;
end;
{ TForm1 }
var
bt: TBackgroundThread;
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
// Create a background thread which runs X seconds and then terminates itself.
bt := TBackgroundThread.Create(false);
bt.FreeOnTerminate := true;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
// The user closes the app while the background thread is still active
Sleep(2000);
Close;
end;
{ TBackgroundThread }
procedure TBackgroundThread.Execute;
var
i: integer;
x: cardinal;
begin
inherited;
// Simulate some work that the background thread does
x := MaxInt;
for i := 0 to MaxInt do
begin
x := Random(x);
end;
end;
The result is a bit surprising to me: After I close the MainForm, the process will be immediately terminated and the background thread will get hard-killed.
Now I have a few questions about this:
After the closing of the MainForm (= exit of the main thread), should I manually terminate all created threads via .Terminate or will that be done automatically?
Shall my threads only check for Self.Terminated or should they also check for Application.Terminated ?
Why does my busy thread as shown above gets immediately killed when I close the application? I expected that the process Project1.exe will run until all threads have finished by themselfes. (And as described above, we had seen an application where the main form is closed, but a thread is preventing the process of being closed).
How is it possible then, that our real application's process does not terminate because of a running background thread? Might it have something to do with the Internet stuff, which might cause the app to wait until a connection timeout is reached?
Closing the main form is not synonymous with exiting the main thread. Code continues to run after the form is closed. In particular, units are finalized.
If you handle your test thread's OnTerminate event, or put a breakpoint in the Terminate method, you'll see that it's not called automatically when your program exits. You'll have to call it yourself. But note also that a thread doesn't stop running just because Terminate is called. It continues running until it stops itself or it's terminated forcefully. Call WaitFor to wait for it to terminate.
Don't bother checking Application.Terminated; the thread's property should be sufficient.
Your thread gets terminated forcefully as your program exits because eventually your program calls ExitProcess, and one of the things the OS does there is to terminate all other threads. It doesn't call Terminate on them because the OS doesn't know about Delphi classes and methods.
You'll have to do some more debugging to determine why your program doesn't terminate promptly for your customers. You say you can't reproduce the problem in house, and you've written a test program that doesn't exhibit the problem, either. You'll have to find a customer who will cooperate with your further debugging efforts. Do you really know it's the thread that's holding things up, or is that just a guess so far?

The best practice on how to wait for data within thread and write it into file?

I am programming multi-threaded app. I have two threads. On is for transferring some data from device to global data buffer and second is for writing those data to file.
Data from device to buffer is transferring asynchronously. The purpose of second thread should be to wait for specified amount of data to be written in main data buffer and finally to write it to file.
Well the first thread is in DLL and second one is in main app. Temporarily I solve this with events. First thread transfers data from device to main data buffer and counts data and when specified amount of data is transferred it sets an event. The second one waits for event to be signalled and when it is it runs some code for data store. Simple as that it is working.
Thread1.Execute:
var DataCount, TransferedData: Integer;
DataCounter := 0;
while not Terminted do
begin
TransferData(#pData, TransferedData);
Inc(DataCounter, TransferedData)
if DataCounter >= DataCountToNotify then SetEvent(hDataCount);
end;
Thread2.Execute:
hndlArr[0] := hDataCount;
hndlArr[1] := hTerminateEvent;
while (not Terminated) do
begin
wRes := WaitForMultipleObjects(HandlesCount, Addr(hndlArr), false, 60000);
case wRes of
WAIT_OBJECT_0:
begin
Synchronize(WriteBuffer); // call it from main thread
ResetEvent(hndlArr[0]);
end;
WAIT_OBJECT_0 + 1:
begin
ResetEvent(hTerminateEvent);
break;
end;
WAIT_TIMEOUT: Break;
end;
end;
Now I would like to make second thread more independent... so I can make multiple instances of second thread and I don't need to wait for first thread. I would like to move data counting part of code from first thread to second one so I won't need data counting in first thread anymore. First one will be just for data transfer purpose.
I would like to use second one as data counter and to store data. But now I will have to loop and constantly check manually for specified data amount. If I had while loop I will have to add some sleep so second thread will not decrease computer performances but I don't know how long should sleep be while speed of data transfer in firts thread is not constant and thus speed of counting in second thread will vary.
My guess that this code sample is not good:
Thread2.Execute:
var DataCount: Integer;
DataIdx1 := GetCurrentDataIdx;
while (not Terminated) do
begin
if (GetCurrentDataIdx - DataIdx1) >= DataCountToNotify then
begin
Synchronize(WriteBuffer);
DataIdx1 := GetCurrentIdx;
end;
sleep(???);
end;
So my question is what is the best approach to solve that issue with data counting and storing it within second thread? What are your experiences and suggestions?
You have some issues. #LU RD has already pointed one out - don't synchronize stuff that does not need to be synchronized. It's not clear what 'WriteBuffer' does, but the file system and all databases I have used are just fine to have one thread opening a file/table and writing to them.
Your buffer system could probably do with some attention. Is there some 'specified data amount' or is this some notional figure that allows lazy writing?
Typically, producer and consumer threads exchange multiple buffer pointers on queues and so avoid sharing any single buffer. Given that this is a DLL and so memory-management calls can be problematic, I would probably avoid them as well by creating a pool of buffers at startup to transfer data round the system. I would use a buffer class rather than just pointers to memory, but it's not absolutely required, (just much more easy/flexible/safe).
Sleep() loops are a spectacularly bad way of communicating between threads. Sleep() does hae its uses, but this is not one of them. Delphi/Windows has plenty of synchronization mechanisms - events, semaphores, mutexes etc - tha make such polling unnecessary.
LU RD has also mentioned the problems of parallel processing of data whose order must be preserved. This often requires yet another thread, a list-style collection and sequence-numbers. I wouldn't try that until you have the inter-thread comms working well.
If you want to avoid the Sleep() call in your second thread, use a waitable timer like TSimpleEvent.
Set the sleep time to handle all your timing conditions.
There is an advantage of using this scheme instead of a normal Sleep(), since a waitable timer will not put the thread into a deep sleep.
To dispose the thread, see comments in code.
var
FEvent: TSimpleEvent;
FSleepTime: Integer = 100; // Short enough to handle all cases
Constructor TThread2.Create;
begin
Inherited Create( False);
FEvent := TSimpleEvent.Create;
Self.FreeOnTerminate := True;
end;
procedure TThread2.Execute;
var
DataCount: Integer;
begin
DataIdx1 := GetCurrentDataIdx;
while (fEvent.WaitFor(FSleepTime) = wrTimeout) do
begin
if Terminated then
break;
// Do your work
if (GetCurrentDataIdx - DataIdx1) >= DataCountToNotify then
begin
// Write data to buffer
DataIdx1 := GetCurrentIdx;
end;
end;
end;
// To stop the thread gracefully, call this instead of Terminate or override the DoTerminate
procedure TThread2.SetTerminateFlag;
begin
FEvent.SetEvent;
end;

Resources