[Shootout-list] New version of the threads Ada bench

Pascal Obry pascal@obry.net
Fri, 18 Mar 2005 19:21:27 +0100


This one, should be working.

-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org
--
-- Contributed by Jim Rogers
-- Fixed by Pascal Obry on 2005/03/18

with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Text_IO;         use Ada.Text_IO;
with Ada.Command_Line;    use Ada.Command_Line;

procedure Process is

   type Link;
   type Link_Access is access Link;

   task type Link (Next_Link : Link_Access)is
      pragma Storage_Size (100_000);
      entry Receive (I : in Integer);
   end Link;

   task body Link is
      Val : Integer;
   begin
      accept Receive (I : in Integer) do
         Val := I;
      end Receive;

      if Next_Link = Null then
         Put(Item => Val + 1, Width => 0);
         New_Line;
      else
         Next_Link.Receive (Val + 1);
      end if;
   end Link;

   Num_Tasks : Positive := 251;
   New_Task  : Link_Access;
   Last_Task : Link_Access := null;

begin
   if Argument_Count > 0 then
      Num_Tasks := Positive'Value (Argument (1));
   end if;

   for Item in 1..Num_Tasks loop
      New_Task := new Link (Last_Task);
      Last_Task := New_Task;
   end loop;

   New_Task.Receive (0);
end Process;


Pascal.

-- 

--|------------------------------------------------------
--| Pascal Obry                           Team-Ada Member
--| 45, rue Gabriel Peri - 78114 Magny Les Hameaux FRANCE
--|------------------------------------------------------
--|              http://www.obry.org
--| "The best way to travel is by means of imagination"
--|
--| gpg --keyserver wwwkeys.pgp.net --recv-key C1082595