non-preemptive tasking on GNAT 2020 Windows 10 multicore AMD

[Dan Winslow <dandwinslow@gmail.com>]

I am trying to achieve true non-preemptive tasking using gnat 2020 CE on a windows 10 environment. I have placed this in the gnat.adc file:

pragma Task_Dispatching_Policy(Non_Preemptive_FIFO_Within_Priorities);

Without this gnat.adc setting, the tasks switched back and forth a great deal, as you would expect with preemptive tasking. Putting the pragma in the gnat.adc file seemed to affect the granularity of the task switching on my test program below, in that it lengthened the time that each task executed consecutive loops, but they still switched over to each other eventually. Here is the test program:


with Ada.Text_IO; Use Ada.Text_Io;
 
procedure Test is


   Task Type One is
   End;  

   Task Type Two;

   Task body One is
     x : Integer := 0;
   Begin
     put_line("one");
     Loop
       x:=x+1;
       if x > 10000000 Then
         exit;
       end if;  
     End Loop;
     Put_line("Task one done, x=" & x'img);
   End;

   Task body Two is
     x : Integer := 0;
   Begin
     put_line("two");
     Loop
       x:=x+1;
       if x > 1000 Then
         exit;
       end if;  
     End Loop;
     Put_line("Task two done, x=" & x'img);
   End;

  a : One;
  B : two;
begin
   
  Null;
End;

Here is the compile line:

gnatmake -gnat2012 -gnatX -f -g test.adb -gnatwA -I. -I..  -D obj


And here is the output:

one
two
Task two done, x= 1001
Task one done, x= 10000001


I expected the opposite, that task one would execute first, which it did, but that it would also finish first because there's no reason for it to yield to two without preemption. It looks to me like I am not actually getting non-preemptive tasking, and I would like to know why.

After some looking I found the 2012 attribute 'with CPU', and produced test code :

With System.Multiprocessors;     use System.Multiprocessors;

with Ada.Text_IO; Use Ada.Text_Io;
 
procedure Test is

   Task Type One with Cpu=>1 is
   End;  

   Task Type Two with Cpu=> 1 is
   end;
   
   x,y : integer := 0;
   limit : integer := 1000000;

   Task body One is
   Begin
     put_line("one");
     Loop
       if y > 0 then 
         raise tasking_error;
       end if;  
       x:=x+1;
       if x > limit Then
         exit;
       end if;  
     End Loop;
     Put_line("Task one done, x=" & x'img);
   Exception
     When others =>
     put_line("task one died, x=" & x'img);  
   End;

   Task body Two is
   Begin
     put_line("two");
     Loop
       y:=y+1;
       if y > limit Then
         exit;
       end if;  
     End Loop;
     Put_line("Task two done, y=" & y'img);
   Exception
     When others =>
     put_line("task two died");  
   End;

  a : One;
  B : two;
begin
  put_line(Number_Of_CPUs'img & " cpu's"); 
  While (x < limit+1) or (y < limit+1) loop
    Delay 0.0;
  End Loop;  
  put_line("main done, x " & x'img & " y " & y'img);
End;


which produces output


one
two
 24 cpu's
task one died, x= 310528
Task two done, y= 1000001
^C

(of course, I have to ctl-c out since main never finishes.)

This happens whether or not I have the scheduling pragma in gnat.adc. Does Windows just not respect processor assignment and/or the scheduling pragma?

(Sorry for no code blocks, not sure how to do that here)