[Shootout-list] Ada threads-flow
Pascal Obry
pascal@obry.net
Thu, 17 Mar 2005 18:27:06 +0100
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