I've been reading a little bit about tasks in ada at http://en.wikibooks.org/wiki/Ada_Programming/Tasking and thought that i'll write a little thing with tasks myself. Since i've read a small course on Pintos recently i thought i'd implement a little readers-writers algorithm. This is my attempt at it:
procedure Test_Queue is
type Int_Array is array(1..10) of Integer;
task type Queue is
entry Quit;
entry Pop(Elem : out Integer);
entry Push(Elem : in Integer);
end Queue;
task body Queue is
Elems_In_Queue : Integer := 0;
Q : Int_Array;
begin
loop
select
accept Push(Elem : in Integer) do
Put_Line("Push");
Elems_In_Queue := Elems_In_Queue + 1;
Q(Elems_In_Queue) := Elem;
end Push;
or
when Elems_In_Queue > 0 =>
accept Pop(Elem : out Integer) do
Put_Line("Pop");
Elem := Q(Elems_In_Queue);
Elems_In_Queue := Elems_In_Queue - 1;
end Pop;
else
delay 1.0;
Put_Line("Waited");
accept Quit;
exit;
end select;
end loop;
Put_Line("Got out of the loop");
end Queue;
Q : Queue;
X : Integer;
begin
Put_Line("Started");
Q.Push(10);
Put_Line("Pushed");
Q.Push(11);
Put_Line("Pushed");
Q.Pop(X);
Put_Line("Integer:" & Integer'Image(X));
Q.Quit;
Put_Line("Done");
end Test_Queue;
Might be worth mentioning that the behaviour i would like to see is that when no operations (push/pop) have been made to the queue/stack for 1 second i would like the task to terminate/exit the infinite loop.
But this just outputs "Started" and then goes to my delay 1.0 and outputs "Wait". This is not exactly what I expected since i have accept for at least push and that is the first thing i call. Where have i been thinking wrong and why doesn't this work? Also, are there any more sources with some examples as for how to do tasking in Ada? I managed to implement this by creating a Semaphore and Lock in 2 different tasks but that seemed to be a bad solution and not very adaesque.
Having improved the diagnostics, it is clear that on startup, neither of the Select alternatives was immediately available so the Queue task was going straight to the Else part, and after 1 second delay, waiting to accept Quit.
Meanwhile the main task was blocking on its first (unconditional, untimed!) Push entry call, so that it could never issue the Quit entry call. Result : Deadlock.
The solution (described in Burns & Welling on p.108) is simply to change ELSE to OR so that the third (Delay) option is still a Select alternative. Then in each iteration, the earliest of (Push, Pop or Delay) will be accepted.
Related
How to implement a Cron task in Ada ?
The precision of the Cron task can be 1 second; sub-seconds are not necessary.
with Ada.Text_IO;
With Ada.Calendar;
With Ada.Calendar.Formatting;
use Ada.Text_IO;
use Ada.Calendar;
use Ada.Calendar.Formatting;
package body Cronjob is
procedure Run_Cron_Task is
task T;
task body T is
begin
loop
declare
Now:Time:=Ada.Calendar.Clock;
My_Hour:Hour_Number:=Ada.Calendar.Formatting.Hour(Now);
My_Minute:Minute_Number:=Ada.Calendar.Formatting.Minute(Now);
My_Second:Second_Number:=Ada.Calendar.Formatting.Second(Now);
begin
if My_Hour = 01 And My_Minute = 00 And My_Second = 01 then -- time 01:00:00
Put_Line("We are running Cronjob at Time");
Put_Line(Image(Now));
delay 1.0; -- extra delay ..make that the crone doesn't get triggered twice
end if;
delay 0.5; -- not sure about the delay here
end;
end loop;
end T;
begin
null;
end Run_Cron_Task;
end Cronjob;
Maybe somebody have an more elegant way how to implement that?
Adopting the delay example:
task body T is
use Ada.Calendar;
Now : Time := Clock;
-- Next will be the next moment in time for which we want to
-- execute jobs. we initialize it to the nearest full second.
-- that may be earlier or later than Now.
Next : Time := Time_Of (
Year => Year (Now),
Month => Month (Now),
Day => Day (Now),
Seconds => Day_Duration'Round (Seconds (Now))
);
begin
loop
-- to be robust, we iterate through all seconds from Next to Now
-- here. this guarantees that jobs get executed even when seconds
-- are skipped (because a job takes too long or because other
-- tasks take away our precious CPU time).
--
-- on first iteration, this may be completely skipped if we rounded up.
while Next <= Now loop
declare
My_Hour : Hour_Number := Formatting.Hour (Next);
My_Minute : Minute_Number := Formatting.Minute (Next);
My_Second : Second_Number := Formatting.Second (Next);
begin
-- call any jobs scheduled for current time here
-- ... skip ...
end;
Next := Next + 1;
end loop;
-- now delay until we reach our Next second.
delay until Next;
Now := Clock;
end loop;
end T;
You can make this more efficient if you increase Next until you actually find a job that wants to be executed, see code below. However be aware that this has some pitfalls:
if there is no job, this task will never sleep and eventually overflow its Next variable.
if you can dynamically add jobs in some other task, this task will skip any newly added jobs before the next job that has already been known when it went to sleep.
-- instead of the while loop
loop
declare
My_Hour : Hour_Number := Formatting.Hour (Next);
My_Minute : Minute_Number := Formatting.Minute (Next);
My_Second : Second_Number := Formatting.Second (Next);
begin
if Job_Available_For (My_Hour, My_Minute, My_Second) then
exit when Next > Now;
-- call any jobs scheduled for current time here
-- ... skip ...
end if;
Next := Next + 1;
end;
end loop;
I have to call a function in a anonymous thread in a while
my sample function is like this, just for print output:
function processPureTmFrame(rowFrame : string;tmDataGroupRef:string ):string;
TThread.Synchronize(nil,
procedure
begin
form2.Memo1.Lines.Add( tmSlitFrame );
end
);
end;
when i call the function like this :
code1
while tmBody.Length>0 do
begin
tmBodyFrameLength := ((hextodec( copy(tmBody,11,2) )+6)*2)+2;
tmSplitFrame := copy(tmBody , 1 , tmBodyFrameLength );
delete( tmBody, 1, tmBodyFrameLength );
myThread := TThread.CreateAnonymousThread(
procedure
begin
processPureTmFrame( tmSplitFrame , tmDataGroupRef );
end);
myThread.Start;
end;
in the first cycle of loop the output is missing
but when i call my code without thread every thing is ok!!
code2
while tmBody.Length>0 do
begin
tmBodyFrameLength := ((hextodec( copy(tmBody,11,2) )+6)*2)+2;
tmSplitFrame := copy(tmBody , 1 , tmBodyFrameLength );
delete( tmBody, 1, tmBodyFrameLength );
processPureTmFrame( tmSplitFrame , tmDataGroupRef );
end;
the correct output must be like this
0851C007000C010100000007581850C001F116
0836C0BE001003627169DCA200000000000090D72AACAF
0814C0B6001C03197169DCA31901E2041211131D001F00001F1E1C1F1F1E1E1E0077AA
0814C0B7001E03197169DCA31902FE00540F0000000000000000000000000000000000E238
0814C0B8000B03197169DCA31903FE01384E
0817C0B9000D05017169DCA3E6010190B03F042D
0852C000000B036200000000FAFFFFBF16A3
0852C001000B036200000001F4FF00000000
but when call in thread(code 1) its is like
0836C0BE001003627169DCA200000000000090D72AACAF
0814C0B6001C03197169DCA31901E2041211131D001F00001F1E1C1F1F1E1E1E0077AA
0814C0B7001E03197169DCA31902FE00540F0000000000000000000000000000000000E238
0814C0B8000B03197169DCA31903FE01384E
0817C0B9000D05017169DCA3E6010190B03F042D
0852C000000B036200000000FAFFFFBF16A3
0852C001000B036200000001F4FF00000000
without thread(code 2) output is ok
Note #1: I don't get any error like:
System Error. Code:1400. Invalid window handle or any thing else
Note #2: as I said just first cycle of while not sending to the new threads. Other lines are sending and processing just fine!
The problem is that the anonymous method captures variables. Because the variable is captured, its value changes during the main loop. Essentially all the threads share the same variable. The threads run in parallel with the main loop and there are no ordering constraints. So it's perfectly possible that the main loop modifies the captured variable before one of your threads has a chance to use the value.
Your code would work with value capture (as opposed to variable capture). Value capture is not supported directly but the same effect is easy to simulate. See Anonymous methods - variable capture versus value capture.
I would comment though that this threading code is going to be slower than the serial code. What are you hoping to achieve?
I have following code:
TThread.Synchronize(nil,
procedure
begin
with Scope.New(TManualCaptchaForm.Create(img)) do
if It.ShowModal() = mrOk then
res := It.edtResolved.Text;
end
);
Why does the form appear several times when multiple TThreads use this procedure for synchronization? I know a workaround, and there is nothing unusual (e. g. no other "hand-made" ways to sync with main thread), but why am I not experiencing a lock?
Yes, Scope.New is kinda smart-pointer, BUT only i see TThread.Synchronize and passed closure? Documentation says that any method/closure passed to TThread.Synchronize will be execute inside main thread. Obviously, ShowModal must block main thread, but it didn't do that. As for me, it's very strange that any other window start behave as main thread and pump synchronization queue.
P. s. almost MVP:
TThread.Synchronize(nil,
procedure
var Form: TForm1;
begin
Form := TForm1.Create(nil);
try
Form.ShowModal();
finally
Form.Free;
end;
end
);
Run this code in 2+ threads and see bug. Anyway, now I know that synchronization queue pumped by any window message loop, not just by main form.
Btw, my question was "Why TThread.Synchronize behave so unclear/not logically?", not about my own code.
The fundamental misunderstanding here is that because .ShowModal is a blocking call you expect that it also suspends message processing. It does not. When you create a modal window the modal window takes over message processing - it must do this or the window would not function. The main thread is still processing the message loop, it is just doing it in a different context.
If you want to think of it this way, ShowModal behaves a lot like Application.ProcessMessages. This has nothing to do with Synchronize. If you examine the code for ShowModal you find :
{ ... }
Show;
try
SendMessage(Handle, CM_ACTIVATE, 0, 0);
ModalResult := 0;
{ *** Here is your message loop *** }
repeat
Application.HandleMessage;
if Application.Terminated then ModalResult := mrCancel else
if ModalResult <> 0 then CloseModal;
until ModalResult <> 0;
{ *** ------------------------- *** }
Result := ModalResult;
SendMessage(Handle, CM_DEACTIVATE, 0, 0);
if GetActiveWindow <> Handle then ActiveWindow := 0;
finally
Hide;
end;
{ ... }
If you want to prevent reentrance here you have to devise your own explicit method to do so.
I am new to parallel programming and am trying to find out why I occasionally get an EmonitorLockException:Object lock not owned when I increase the number of parrallel tasks to run. Is the case that the Threads become tangled the more tasks I run. Or is my code code not correct?
{$APPTYPE CONSOLE}
uses
System.SysUtils, System.Threading, System.Classes, System.SyncObjs, System.StrUtils;
const
WorkerCount = 10000; // this is the number of tasks to run in parallel note:when this number is increased by repeated factors of 10
// it takes longer to produce the result and sometimes the program crashes
// with an EmonitorLockException:Object lock not owned . Is it that my program is not written correctly or efficiently to run
// a large number of parallel taks and the Threads become entagled.
// Eventually I would like to optimeize the program to find the optimal number of tasks to run in parallel so as to find the result in the shortest time.
// This becomes important when the word sequence is increased to six or more letters.
sequencetofind='help'; // letter sequence to find randomly
sequencelengthplus1=5; // the ength of the letter sequence plus 1 extra letter for a check to see if it is working
var
Ticks: Cardinal;
i,k,m: Integer;
sequencenum: Integer;
alphabetarray:array[1..26] of string;
v:char;
copyarray,letters:array[1..sequencelengthplus1] of string;
tasks: array of ITask;
LTask: ITask;
Event1:TEvent;
sequencesection:TCriticalSection;
function findsequencex(index: Integer): TProc;
begin
Result := procedure
var
counter,m:integer;
r:integer;
z:string;
lettersx:array[1..sequencelengthplus1] of string;
begin
for m:=1 to sequencelengthplus1-1 do
lettersx[m]:=letters[m];
randomize;
counter:=1;
repeat
r:=random(26)+1;
z:=alphabetarray[r]; //randomly find letters until matched with the sequence
if z=letters[counter] then
begin
copyarray[counter]:=z;
counter:=counter+1; // increase counter when successfully found a match
end
else
counter:=1; // if match fails start again and look for the first letter
if (counter=sequencelengthplus1) then
begin // if all letters found in correct order find one more letter as a check
sequencesection.Acquire; //critical section start
r:=random(26)+1;
z:=alphabetarray[r];
TInterlocked.CompareExchange(sequencenum,r,0);
copyarray[sequencelengthplus1]:=z;
Event1.SetEvent; // set in motion the process to stop all other tasks
sequencesection.release; // critical section end
end;
until (Event1.WaitFor(0)=wrSignaled); // check to see if all letters of the sequence has been found
end;
end;
procedure Parallel2;
var
i,sequencevalue,j: Integer;
begin
Event1:=TEvent.Create(nil,true,false,'noname'); // sequence checker
Event1.resetevent;
sequencenum := 0;
Ticks := TThread.GetTickCount;
SetLength(Tasks, WorkerCount); // number of parallel tasks to undertake
for i := 0 to WorkerCount-1 do
Tasks[i]:=TTask.Run(findsequencex(i));
TTask.WaitForAny(Tasks); // wait for the first one to successfully finish
TThread.Synchronize(nil,
procedure
begin
for LTask in Tasks do
LTask.Cancel; // kill the remaining tasks
TInterlocked.Add (sequencevalue, sequencenum); // note the random letter check
end);
Ticks := TThread.GetTickCount - Ticks;
writeln('Parallel time ' + Ticks.ToString + ' ms, last random alphabet sequence number: ' + sequencenum.ToString+' random letter is = '+alphabetarray[sequencevalue]);
end;
begin
sequencesection:=TCriticalSection.Create;
for m:=1 to (sequencelengthplus1-1) do
begin
letters[m]:=copy(sequencetofind,m,1);
writeln(letters[m]);
end;
i:=0;
for v:='a' to 'z' do
begin
i:=i+1;
alphabetarray[i]:=v;
end;
try
begin
Parallel2; // call the parrallel procedure
writeln('finished');
for m:=1 to sequencelengthplus1 do
writeln(copyarray[m]);
if (Event1.WaitFor(0)=wrSignaled) then
begin
writeln('event signaled');
if (sequencenum=0) then writeln('sequence is null');
end;
Event1.Free;
sequencesection.free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
You've got masses of shared global variables that you access without any synchronization. For instance:
if z = letters[counter] then
begin
copyarray[counter] := z;
counter := counter + 1;
// increase counter when successfully found a match
end
Here copyarray is a global that is shared between all the tasks. This data race alone could result in the error you see. There are other similar races. And I am sure that there are many many more problems. The entire code cannot be salvaged. You need to throw it away and start again.
Here are some tips:
Pick a simpler task to begin learning about parallel programming.
Find a good book or tutorial on the subject. Start small and work up to your actual problem.
Stop using global variables. Sharing data with globals can only lead to pain. Sharing is your enemy. Keep it to a minimum.
If you need to share data do so in an explicit manner rather than using globals. And make sure the access to shared data is synchronized.
Don't call Randomize from inside your thread. It's not threadsafe. Call it once at startup.
Random is not threadsafe. Find a thread safe PRNG, or synchronise calls to Random. The former option is to be preferred.
Don't call TThread.Synchronize from the main thread.
Manage lifetime the standard way. When you create an object, use try and finally to protect its lifetime. Don't create objects in one function and destroy them in some other function.
Format your code so that it is readable. If you cannot read your code, how will you ever understand it?
With the greatest of respect, it's clear that you've not mastered serial programming yet. You should aim to be proficient at serial programming before moving to parallel programming. Parallel programming is at least an order of magnitude harder.
With that in mind, try to write a good, clean version of your program in serial form. Then think about how to transform it to a parallel version.
I have a time consuming routine which I'd like to process in parallel using Delphi XE7's new parallel library.
Here is the single threaded version:
procedure TTerritoryList.SetUpdating(const Value: boolean);
var
i, n: Integer;
begin
if (fUpdating <> Value) or not Value then
begin
fUpdating := Value;
for i := 0 to Count - 1 do
begin
Territory[i].Updating := Value; // <<<<<< Time consuming routine
if assigned(fOnCreateShapesProgress) then
fOnCreateShapesProgress(Self, 'Reconfiguring ' + Territory[i].Name, i / (Count - 1));
end;
end;
end;
There is really nothing complex going on. If the territory list variable is changed or set to false then the routine loops around all the sales territories and recreates the territory border (which is the time consuming task).
So here is my attempt to make it parallel:
procedure TTerritoryList.SetUpdating(const Value: boolean);
var
i, n: Integer;
begin
if (fUpdating <> Value) or not Value then
begin
fUpdating := Value;
n := Count;
i := 0;
TParallel.For(0, Count - 1,
procedure(Index: integer)
begin
Territory[Index].Updating := fUpdating; // <<<<<< Time consuming routine
TInterlocked.Increment(i);
TThread.Queue(TThread.CurrentThread,
procedure
begin
if assigned(fOnCreateShapesProgress) then
fOnCreateShapesProgress(nil, 'Reconfiguring ', i / n);
end);
end
);
end;
end;
I've replaced the for-loop with a parallel for-loop. The counter, 'i' is locked as it is incremented to show progress. I then wrap the OnCreateShapeProgress event in a TThread.Queue, which will be handled by the main thread. The OnCreateShapeProgress event is handled by a routine which updates the progress bar and label describing the task.
The routine works if I exclude the call to the OnCreateShapeProgress event. It crashes with an EAurgumentOutOfRange error.
So my question is simple:
Am I doing anything anything stupid?
How to do you call an event handler from within a TParallel.For loop or TTask?
The most obvious problem that I can see is that you queue to the worker thread.
Your call to TThread.Queue passes TThread.CurrentThread. That is the very thread on which you are calling TThread.Queue. I think it is safe to say that you should never pass TThread.CurrentThread to TThread.Queue.
Instead, remove that parameter. Use the one parameter overload that just accepts a thread procedure.
Otherwise I'd note that the incrementing of the progress counter i is not really handled correctly. Well, the incrementing is fine, but you then read it later and that's a race. You can report progress out of order if thread 1 increments before thread 2 but thread 2 queues progress before thread 1. Solve that by moving the counter increment code to the main thread. Simply increment it inside the queued anonymous method. Added bonus to that is you no longer need to use an atomic increment since all modifications are on the main thread.
Beyond that, this QC report seems rather similar to what you report: http://qc.embarcadero.com/wc/qcmain.aspx?d=128392
Finally, AtomicIncrement is the idiomatic way to perform lock free incrementing in the latest versions of Delphi.