Ada threads-flow

[Pascal Obry-2]

Here is a fixed version of the Ada threads-flow test.

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

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 message is
   type Link;
   type Link_Access is access Link;
   task type Link (Next_Link : Link_Access; Num_Iter : Positive) is
      pragma Storage_Size (100000);
      entry Receive (I : in Integer);
   end Link;

   task body Link is
      Val     : Integer := 0;
      New_Val : Integer;
   begin
      for iter in 1 .. Num_Iter loop
         accept Receive (I : in Integer) do
            New_Val := I;
         end Receive;

         if Next_Link = null then
            Val := Val + New_Val + 1;
         else
            Val := New_Val + 1;
            Next_Link.Receive (Val);
         end if;
      end loop;

      if Next_Link = null then
         Put (Item => Val, Width => 0);
         New_Line;
      end if;
   end Link;

   Num_Tasks : Positive := 3000;
   Num_Iter  : Positive := 200;
   New_Task  : Link_Access;
   Last_Task : Link_Access := null;
begin
   if Argument_Count > 0 then
      Num_Iter := Positive'Value (Argument (1));
   end if;

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

   for iter in 1 .. Num_Iter loop
      New_Task.Receive (0);
   end loop;
end message;

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



_______________________________________________
Shootout-list mailing list
Shootout-list@...
http://lists.alioth.debian.org/mailman/listinfo/shootout-list