Tasking: Very slow response - task

Question

My actual program creates a task which I does not react to control messages as it should. As it has grown pretty large, I present a short test program with the same control logic. It creates a background task which repeates a loop every 0.1s. Depending on a protected flag "running" it prints out an 'a', or does nothing. When I set "running", the program goes off immediately, printing the 'a's. But when I set "stopreq", it takes seconds, sometimes well over 10, until it stops. I would expect a response time of 0.1 or 0.2s.
Anybody has an explanation and a solution?
My main program opens a window with 3 buttons: "Start", which calls the subprogram Start below, "Stop", which calls Request_Stop, and "Quit" calling Request_Quit. I am working on a PC running Linux.
Here comes the body of my Tasking package. If you need more, just tell me and I post the other parts.
with Ada.Text_IO;
with Ada.Calendar;
package body Tasking is
t_step: constant Duration:= 0.1;
dti: Duration;
protected Sync is
procedure Start; -- sim. shall start
procedure Request_Stop; -- sim. shall stop
procedure Stop_If_Req;
function Is_Running return Boolean; -- sim. is running
procedure Request_Quit; -- sim.task shall exit
function Quit_Requested return Boolean; -- quit has been requested
procedure Reset_Time;
procedure Increment_Time (dt: Duration);
procedure Delay_Until;
private
running: Boolean:= false;
stopreq: Boolean:= false;
quitreq: Boolean:= false;
ti: Ada.Calendar.Time;
end Sync;
protected body Sync is
procedure Start is begin running:= true; end Start;
procedure Request_Stop is
begin
if running then stopreq:= true; end if;
end Request_Stop;
procedure Stop_If_Req is
begin
if stopreq then
running:= false;
stopreq:= false;
end if;
end Stop_If_Req;
function Is_Running return Boolean is begin return running; end Is_Running;
procedure Request_Quit is begin quitreq:= true; end Request_Quit;
function Quit_Requested return Boolean
is begin return quitreq; end Quit_Requested;
procedure Reset_Time is begin ti:= Ada.Calendar.Clock; end Reset_Time;
procedure Increment_Time (dt: Duration) is
begin
ti:= Ada.Calendar."+"(ti, dt);
dti:= dt;
end Increment_Time;
procedure Delay_Until is
use type Ada.Calendar.Time;
now: Ada.Calendar.Time;
begin
now:= Ada.Calendar.Clock;
while ti < now loop -- while time over
ti:= ti + dti;
end loop;
delay until ti;
end Delay_Until;
end Sync;
task body Thread is
begin
Ada.Text_IO.Put_Line("starting task");
while not Sync.Quit_Requested loop
if sync.Is_Running then
sync.Increment_Time (t_step);
sync.Delay_Until;
Ada.Text_IO.Put("a");
sync.Stop_If_Req;
else
delay t_step;
sync.Reset_Time;
end if;
end loop;
end Thread;
procedure Start is
begin
Sync.Start;
end Start;
function Is_Running return Boolean is
begin
return Sync.Is_Running;
end Is_Running;
procedure Request_Stop is
begin
Ada.Text_IO.Put_Line("");
Sync.Request_Stop;
end Request_Stop;
procedure Request_Quit is
begin
Sync.Request_Quit;
end Request_Quit;
end Tasking;

Answer 1

Your code is too poorly described and commented for me to understand what you want it to do.
But using a "delay until" statement in a protected operation (Sync.Delay_Until) is not correct -- it is a "bounded error". If it works, it probably blocks all other calls to that protected object until the delay has expired. I suggest you should start there when you try to correct the code.

Answer 2

Thanks to your comments, the program is working correctly now.
To Jesper Quorning:
"Time in past" was not a problem here, but could be so in my real software project. I included a remedy nevertheless in the corrected version below, so it could serve as a pattern for others. Thanks for the hint.
To Niklas Holsti:
I shifted "delay until" out of the protected operation and the program now works as expected, thanks for the explanation. (Sometimes a program which works badly is worse than one which doesn't work at all, because in the latter case you take compiler warnings more seriously.)
What I want to do is:
Execute an application at precisely defined time intervals
Being able to enable/disable it anytime
Giving it time to stop only when in a well defined state
Knowing, when it really has stopped
Controlled termination of the whole thing.
My idea of realization was:
Call the application in an endless loop as separate task
Check whether exit has been requested at the top of the loop
An if statement which executes the application if enabled
Simple delay otherwise.
Control from other packages is done with the public subprograms
Start, Is_Running, Request_Stop, Request_Quit.
Besides the corrections mentioned above, I renamed some items to make their role clearer.
If there is a standard solution, different from mine, I would like to see it.
Here comes my corrected program:
with Ada.Text_IO;
with Ada.Calendar;
package body Tasking is
t_step: constant Duration:= 0.1;
protected Sync is
procedure Enable_App; -- enable application
procedure Request_Disable; -- request disabling of app.
procedure Disable_If_Req; -- disable app. if requested
function Enabled return Boolean; -- application is enabled
procedure Request_Quit; -- task shall terminate
function Quit_Requested return Boolean; -- task termination requested
procedure Set_Time (t: Ada.Calendar.Time); -- set execution time
function Get_Time return Ada.Calendar.Time; -- get execution time
private
running: Boolean:= false; -- application is enabled
stopreq: Boolean:= false; -- disabling has been requested
quitreq: Boolean:= false; -- task termination requested
ti: Ada.Calendar.Time; -- time of next app. execution
end Sync;
protected body Sync is
procedure Enable_App is begin running:= true; end Enable_App;
procedure Request_Disable is
begin
if running then stopreq:= true; end if;
end Request_Disable;
procedure Disable_If_Req is
begin
if stopreq then
running:= false;
stopreq:= false;
end if;
end Disable_If_Req;
function Enabled return Boolean is
begin return running; end Enabled;
procedure Request_Quit is
begin quitreq:= true; end Request_Quit;
function Quit_Requested return Boolean
is begin return quitreq; end Quit_Requested;
procedure Set_Time (t: Ada.Calendar.Time) is
begin ti:= t; end Set_Time;
function Get_Time return Ada.Calendar.Time is
begin return ti; end Get_Time;
end Sync;
task body Thread is
use type Ada.Calendar.Time;
now: Ada.Calendar.Time;
begin
Ada.Text_IO.Put_Line("starting task");
while not Sync.Quit_Requested loop
if sync.Enabled then
-- increment time if it is too late
now:= Ada.Calendar.Clock;
while sync.Get_Time <= now loop
sync.Set_Time (sync.Get_Time + t_step);
end loop;
-- wait until next execution time
delay until sync.Get_Time;
-- execute application and set time for next execution
Ada.Text_IO.Put(".");
sync.Set_Time (sync.Get_Time + t_step);
-- disable application if this has been requested
sync.Disable_If_Req;
else
-- wait for enabling and set time for next execution
delay t_step;
sync.Set_Time (Ada.Calendar.Clock + t_Step);
end if;
end loop;
end Thread;
procedure Start is
begin
Sync.Enable_App;
end Start;
function Is_Running return Boolean is
begin
return Sync.Enabled;
end Is_Running;
procedure Request_Stop is
begin
Ada.Text_IO.Put_Line("");
Sync.Request_Disable;
end Request_Stop;
procedure Request_Quit is
begin
Sync.Request_Quit;
end Request_Quit;
end Tasking;

Answer 3

Some general ideas about Ada tasking:
Conceptually, an Ada task has its own processor that no other task runs on. Scheduling, such as determining when the task should next do something, is usually the task's responsibility.
When the task has to wait for an event, it is usually best for the task to block than to poll.
Ada.Calendar is typically local time, and can even go backward. Tasks should schedule themselves with Ada.Real_Time if possible.
So I would do something like
protected Control is
procedure Set_Running (Running : in Boolean := True);
-- Set whether the task should run or not
-- Initially Running is False
entry Wait_Until_Running;
-- Blocks the caller until Running is set to True
function Running return Boolean;
-- Returns the current value of Running
procedure Quit_Now;
-- Tell the task to quit
function Quitting return Boolean;
-- Returns True when Quit_Now has been called; False otherwise
private -- Control
Run : Boolean := False;
Quit : Boolean := False;
end Control;
task body T is
Step : constant Ada.Real_Time.Time_Span := Ada.Real_Time.Milliseconds (100);
Next : Ada.Real_Time.Time;
begin -- T
Forever : loop
Control.Wait_Until_Running;
Next := Ada.Real_Time.Clock;
Run : while Control.Running loop
exit Forever when Control.Quitting;
delay until Next;
Next := Next + Step;
-- The task does its thing here
Ada.Text_IO.Put (Item => 'a');
end loop Run;
end loop Forever;
end T;
protected body Control is
procedure Set_Running (Running : in Boolean := True) is
begin
Run := Running;
end Set_Running;
entry Wait_Until_Running when Run is
begin
null;
end Wait_Until_Running;
function Running return Boolean is (Run);
procedure Quit_Now is
begin
Run := True; -- Release the task if it is blocked on Wait_Until_Running
Quit := True;
end Quit_Now;
function Quitting return Boolean is (Quit);
end Control;

Answer 4

Thanks for your new description of the goals, #hreba, and good to hear that your program is working as expected now.
I agree with #Anh Vo that the application task could be controlled with task entries, but I think that using a protected object (PO) is mostly preferable because it decouples the caller (the main task) from the application task -- it does not make the caller wait until the application task is ready to accept the entry call. However, I would reduce the PO to handle the inter-task communication. In the #hreba code, I see no reason for the protected operations Set_Time and Get_Time, as the timing seems completely controlled by the application task anyway.
Here is how I would program this. First, instead of a number of Booleans I would define an enumeration for the state of the application task:
type App_State is (Enabled, Disabled, Stopping, Stopped);
In the #hreba code, it seems the application task is initially "not running", so
Initial_State : constant App_State := Disabled;
The PO would then be declared as (I leave out the comments because I will comment in prose):
protected App_Control is
procedure Enable;
procedure Disable;
procedure Stop;
entry Get_New_State (New_State : out App_State);
entry Wait_Until_Stopped;
private
State : App_State := Initial_State;
Old_State : App_State := Initial_State;
end App_Control;
The PO operations Enable, Disable, and Stop do the evident things:
procedure Enable
is
begin
State := Enabled;
end Enable;
and analogously for Disable and Stop. Stop sets State to Stopping.
The entry Get_New_State will be called in the application task to receive the new state. It is an entry, instead of a function or a procedure, so that it can be made callable only when the state has changed:
entry Get_New_State (New_State : out App_State)
when State /= Old_State
is
begin
New_State := State;
Old_State := State;
if State = Stopping then
State := Stopped;
end if;
end Get_New_State;
Here I made an automatic transition from Stopping to Stopped as soon as the application task has been given New_State = Stopping. If the application task has to do some clean-up before it can be considered really stopped, that transition should be moved to a separate operation, for example procedure App_Control.Has_Stopped, to be called from the application task after that clean-up.
The entry Wait_Until_Stopped can be called in the main task to wait until the application task has stopped. It is very simple:
entry Wait_Until_Stopped
when State = Stopped
is
begin
null;
end Wait_Until_Stopped;
Now for the application task. My design differs in one main point from the original: to make the task more responsive to "stop" commands, I use a timed entry call of Get_New_State to let that call take place while the application task is waiting for its next activation time. This may not matter much if the task is running every 0.1 s, but in some other scenario the task might be running every 10 s, or every 10 minutes, and then it could matter a great deal. So here is the task body:
task body App_Thread
is
use Ada.Calendar;
Period : constant Duration := 0.1;
State : App_State := Initial_State;
Next_Time : Time := Clock + Period;
begin
loop
select
App_Control.Get_New_State (New_State => State);
exit when State = Stopping;
or
delay until Next_Time;
if State = Enabled then
Execute_The_Application;
end if;
Next_Time := Next_Time + Period;
end select;
end loop;
end App_Thread;

Answer 5

To uncouple between calling task and called task, do not use accept {entry name} do statement. Just break this into two separate statements as shown below with entry Start_Work for example
--coupling case
accept Start_Work do
Execute_The_Application
end Start_Work;
--uncoupling case
accept Start_Work;
Execute_The_Application;

Answer 6

Here is my implementation of #hreba's requirement.
package Tasking is
-- more codes
task Thread2 is
entry Start_Work;
entry Stop_Work;
entry Quitting_Time;
end Thread2;
task body Thread2 is
use type Ada.Real_Time.Time;
T_Step : constant Ada.Real_Time.Time_Span := Ada.Real_Time.Milliseconds (100);
Next_Time : Ada.Real_Time.Time := Ada.Real_Time.Clock;
begin
Ada.Text_IO.Put_Line("task Thread2 elaborates and activates");
Forever: loop
select
accept Quitting_Time;
Ada.Text_IO.Put_Line ("task Thread2 terminates. Later alligator");
exit Forever; -- later alligator
or
accept Start_Work;
Working: loop
Ada.Text_IO.Put_Line ("Ada");
Next_Time := Next_Time + T_Step;
select
accept Stop_Work;
exit Working;
or
delay until Next_Time;
end select;
end loop Working;
or
Terminate;
end select;
end loop Forever;
end Thread2;
-- more codes
end Tasking;