The Computer Language
Benchmarks Game

thread-ring Ada 2005 GNAT program

-- The Computer Language Benchmarks Game
-- http://benchmarksgame.alioth.debian.org/
-- contributed by Jim Rogers

with Ada.Text_Io; use Ada.Text_Io;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure ThreadRing is
   
   protected Flag is
      procedure Set(Num : Positive);
      entry Wait(Last : out Positive);
   private
      Done : Boolean := False;
      Id : Positive;
   end Flag;
   protected body Flag is
      procedure Set(Num : Positive) is
      begin
         Done := True;
         Id := Num;
      end Set;
      entry Wait(Last : out Positive) when Done is
      begin
         Last := Id;
      end Wait;
   end Flag;

   type Node;
   type Node_Access is access Node;
   
   Ring : array(1..503) of Node_Access;
   
   task type Node(Id : Positive) is
      entry Start(Next : Node_Access);
      entry Put(Item : in Natural);
      entry Stop;
   end Node;
   
   task body Node is
      Val : Natural;
      Next_Node : Node_Access;
   begin
      accept Start(Next : Node_Access) do
         Next_Node := Next;
      end Start;
      
      loop
         select
            accept Put(Item : in Natural) do
               Val := Item;
            end Put;
         or
            accept Stop;
            exit;
         end select;
         if Val > 0 then
            Val := Val - 1;
            Next_Node.Put(Val);
         else
            Flag.Set(Id);
         end if;
      end loop;
   end Node;
   
   Num_Passes : Natural;
   Last_Node : Positive;
begin
   Num_Passes := Natural'Value(Argument(1));
   for I in Ring'range loop
      Ring(I) := new Node(I);
   end loop;
   Ring(Ring'Last).Start(Ring(1));
   for I in Ring'First..Ring'Last - 1 loop
      Ring(I).Start(Ring(I + 1));
   end loop;
   Ring(1).Put(Num_Passes);
   Flag.Wait(Last_Node);
   Put(Item => Last_Node, Width => 1);
   New_Line;
   for I in Ring'range loop
      Ring(I).Stop;
   end loop;
   
end ThreadRing;
    

NOTES:
64-bit Ubuntu quad core
GNATMAKE 7.2.0
gcc (Ubuntu 7.2.0-8ubuntu3) 7.2.0



Thu, 26 Oct 2017 15:15:30 GMT

MAKE:
gnatchop -r -w threadring.gnat
splitting threadring.gnat into:
   threadring.adb
gnatmake -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp -f threadring.adb -o threadring.gnat_run 
gcc-7 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp threadring.adb
gnatbind-7 -x threadring.ali
gnatlink-7 threadring.ali -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -o threadring.gnat_run

0.64s to complete and log all make actions

COMMAND LINE:
./threadring.gnat_run 50000000

PROGRAM OUTPUT:
292