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;
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.