I got a question about tasking in Ada. I am trying to do a server in Ada that will serve multiple clients at once (using GNAT.Sockets).
Is it possible to dynamically create a task (with passing an argument) and not waiting until this task will complete? Do i have to use external libraries? I really got stuck. Thanks for your help.
The key is in your question, "Is it possible to dynamically create a task [...]”.
If you create a task type, you can create instances of the type using new and they will start running as soon as the allocation is finished.
There are at least two ways to pass parameters. You can constrain the task type (A in the example below) or you can pass the value to a Start entry (B below). If you need a Start entry anyway (to ensure the task doesn’t actually start before you’re ready), or if the parameter is something that can’t act as a constraint (for example, a record) that’s probably the way to go: otherwise there’s not a lot to choose.
with Ada.Text_IO; use Ada.Text_IO;
procedure Unnamed454 is
task type A (Param : Integer) is
end A;
type A_P is access A;
task body A is
begin
Put_Line ("task A running with Param:" & Integer'Image (Param));
delay 2.0;
Put_Line ("exiting task A");
end A;
task type B is
entry Start (Param : Integer);
end B;
type B_P is access B;
task body B is
Param : Integer := 0;
begin
accept Start (Param : Integer) do
B.Param := Param;
end Start;
Put_Line ("task B running with Param:" & Integer'Image (Param));
delay 4.0;
Put_Line ("exiting task B");
end B;
begin
Create_A:
declare
The_A : A_P := new A (42);
begin
Put_Line ("in Create_A block");
end Create_A;
Create_B:
declare
The_B : B_P := new B;
begin
Put_Line ("in Create_B block");
The_B.Start (79);
Put_Line ("exiting Create_B block");
end Create_B;
Put_Line ("exiting main");
end Unnamed454;
results in
task A running with Param: 42
in Create_A block
in Create_B block
task B running with Param: 79
exiting Create_B block
exiting main
then after 2 seconds
exiting task A
then after another 2 seconds
exiting task B
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 just started programming on Ada and I was wondering how to code getters and setters to work with classes attributes.
In fact I am interested in obtaining getters and setters of attributes deadline, period and computingTime of the following package:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Real_Time; use Ada.Real_Time;
package body pkg_tasks is
task body task_a is
deadline : Time_Span := To_Time_Span(25.0);
period : Time_Span := To_Time_Span(25.0);
computingTime : Time_Span := To_Time_Span(10.0);
startingTime : Time;
begin
entry start do
startingTime := Clock;
while (Clock - startingTime) < computingTime loop
end loop;
New_line;
Put_Line("End of task A");
end start;
end task_a;
end pkg_tasks;
In the case of a task, it's quite easy... You can't for the same reason that we answered in your last question, tasks can only have entries which act as a way to synchronize tasks (read part on entries and the followings).
But in fact, you could perform a kind of getters as entries and using selective wait depending on when you want to query your attributes.
Now, about setting attributes on your task, using parameters on your start entry seems to me as the best way to do.
As a note, you are writing about classes attributes but you are currently using no classes at all. Tasks are a first-citizen type in Ada and is not implemented through a class type as it's done in Java. Using object oriented programming is a different beast here.
As said above, generally tasks are not the normal way to do it. Back in Ada83, there were no protected types, so if you needed something like that then you emulated it with a task. That aside, here are some examples using tasks, protected types and classes (or as Ada calls them, Tagged types):
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Real_Time; use Ada.Real_Time;
procedure jdoodle is
------------------------------------------------------
-- Task Example
------------------------------------------------------
task Task_Example is
entry Get(Time : out Time_Span);
entry Set(Time : in Time_Span);
end Task_Example;
task body Task_Example is
Value : Time_Span := To_Time_Span(0.0);
begin
loop
select
accept Get(Time : out Time_Span) do
Time := Value;
end Get;
or
accept Set(Time : in Time_Span) do
Value := Time;
end Set;
or
terminate;
end select;
end loop;
end Task_Example;
------------------------------------------------------
-- Protected type example
------------------------------------------------------
protected type Protected_Example is
procedure Put(Time : Time_Span); -- or use entry
function Get return Time_Span; -- or use procedure or entry
private
Value : Time_Span := To_Time_Span(0.0);
end Protected_Example;
protected body Protected_Example is
procedure Put(Time : Time_Span) is
begin
Value := Time;
end Put;
function Get return Time_Span is
begin
return Value;
end Get;
end Protected_Example;
------------------------------------------------------
-- Class Example
------------------------------------------------------
package Classes is
type Class_Example is tagged limited private;
procedure Put(Self : in out Class_Example; Time : Time_Span);
function Get(Self : in Class_Example) return Time_Span; -- or use procedure
private
type Class_Example is tagged limited record
Value : Time_Span := To_Time_Span(0.0);
end record;
end Classes;
package body Classes is
procedure Put(Self : in out Class_Example; Time : Time_Span) is
begin
Self.Value := Time;
end Put;
function Get(Self : in Class_Example) return Time_Span is
begin
return Self.Value;
end Get;
end Classes;
begin
Put_Line("Starting");
end jdoodle;
Keep in mind the tagged type example is also applicable to regular records and other private types.
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.
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.