Tasking: Very slow response

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;

Solution

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.