From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00, T_TVD_MIME_NO_HEADERS autolearn=ham autolearn_force=no version=3.4.4 X-Google-Thread: 103376,ad4585f2971e47c5 X-Google-NewGroupId: yes X-Google-Attributes: gida07f3367d7,domainid0,public,usenet X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news2.google.com!news2.google.com!npeer03.iad.highwinds-media.com!feed-me.highwinds-media.com!cyclone03.ams2.highwinds-media.com!news.highwinds-media.com!feeder.news-service.com!85.214.198.2.MISMATCH!eternal-september.org!feeder.eternal-september.org!.POSTED!not-for-mail From: Simon Wright Newsgroups: comp.lang.ada Subject: Re: Need some light on using Ada or not Date: Mon, 21 Feb 2011 13:44:04 +0000 Organization: A noiseless patient Spider Message-ID: References: <4d5ef836$0$23753$14726298@news.sunsite.dk> <7ibvl6tn4os3njo3p4kek9kop44nke3n7t@4ax.com> <4d5fd57d$0$6992$9b4e6d93@newsspool4.arcor-online.net> <4D617036.4080902@obry.net> <6nm4m6h6il8j02l9b11qkjsg3k2cjhjul8@4ax.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: mx03.eternal-september.org; posting-host="dFCm8HWntFqmDIilBLqEJQ"; logging-data="25016"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX19Dy+tp5Ztkns2eg8GO380ZYLFYVgD3u0g=" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (darwin) Cancel-Lock: sha1:Bh5VKHu9eXH/HYDE3Lo5CdcpTV4= sha1:Q5jwSJKXMqQN0aElJT+04OI9I4M= Xref: g2news2.google.com comp.lang.ada:18489 Date: 2011-02-21T13:44:04+00:00 List-Id: --=-=-= Brian Drummond writes: > As this is my first experiment with tasking, comments are welcome (and > I'd be interested to see your version). See end. > If people think this is worth submitting to the shootout, I'll go > ahead. I think it definitely is: the only Ada code for binary-trees is single-threaded, so looks needlessly poor. --=-=-= Content-Disposition: inline; filename=binarytrees.ada Content-Description: simple multi-thread version of binary trees benchmark ---------------------------------------------------------------- -- BinaryTrees -- -- Ada 95 (GNAT) -- -- Contributed by Jim Rogers -- Modified by Simon Wright ---------------------------------------------------------------- with Tree_Nodes; use Tree_Nodes; with Ada.Text_IO; use Ada.Text_IO; with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; with Ada.Command_Line; use Ada.Command_Line; with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; with System; procedure Binarytrees is Min_Depth : constant Positive := 4; N : Natural := 1; Stretch_Tree : Tree_Node; Long_Lived_Tree : Tree_Node; Max_Depth : Positive; Stretch_Depth : Positive; task type Check_Tree is pragma Priority (System.Default_Priority - 1); entry Start (Iterations : Positive; Depth : Positive); entry Sum (Result : out Integer); end Check_Tree; task body Check_Tree is Iterations : Positive; Depth : Positive; Tree : Tree_Node; Check : Integer := 0; begin accept Start (Iterations : Positive; Depth : Positive) do Check_Tree.Iterations := Iterations; Check_Tree.Depth := Depth; end Start; for J in 1 .. Iterations loop Tree := Bottom_Up_Tree (J, Depth); Check := Check + Item_Check (Tree); Delete_Tree (Tree); Tree := Bottom_Up_Tree (-J, Depth); Check := Check + Item_Check (Tree); Delete_Tree (Tree); end loop; accept Sum (Result : out Integer) do Result := Check; end Sum; end Check_Tree; begin if Argument_Count > 0 then N := Positive'Value (Argument (1)); end if; Max_Depth := Positive'Max (Min_Depth + 2, N); Stretch_Depth := Max_Depth + 1; Stretch_Tree := Bottom_Up_Tree (0, Stretch_Depth); Put ("stretch tree of depth "); Put (Item => Stretch_Depth, Width => 1); Put (Ht & " check: "); Put (Item => Item_Check (Stretch_Tree), Width => 1); New_Line; Delete_Tree (Stretch_Tree); Long_Lived_Tree := Bottom_Up_Tree (0, Max_Depth); declare subtype Check_Trees_Array_Range is Natural range 0 .. (Max_Depth - Min_Depth) / 2; Check_Trees : array (Check_Trees_Array_Range) of Check_Tree; function Depth (For_Entry : Check_Trees_Array_Range) return Natural is begin return For_Entry * 2 + Min_Depth; end Depth; function Iterations (For_Entry : Check_Trees_Array_Range) return Positive is begin return 2 ** (Max_Depth - Depth (For_Entry) + Min_Depth); end Iterations; begin for D in Check_Trees'Range loop Check_Trees (D).Start (Iterations => Iterations (D), Depth => Depth (D)); end loop; for D in Check_Trees'Range loop Put (Item => Iterations (D) * 2, Width => 0); Put (Ht & " trees of depth "); Put (Item => Depth (D), Width => 0); declare Check : Integer; begin Check_Trees (D).Sum (Result => Check); Put (Ht & " check: "); Put (Item => Check, Width => 0); end; New_Line; end loop; end; Put ("long lived tree of depth "); Put (Item => Max_Depth, Width => 0); Put (Ht & " check: "); Put (Item => Item_Check (Long_Lived_Tree), Width => 0); New_Line; Delete_Tree (Long_Lived_Tree); end BinaryTrees; ---------------------------------------------------------------- -- BinaryTrees -- -- Ada 95 (GNAT) -- -- Contributed by Jim Rogers -- Modified by Simon Wright ---------------------------------------------------------------- with Ada.Unchecked_Deallocation; package body Tree_Nodes is function Bottom_Up_Tree (Item : Integer; Depth : Natural) return Tree_Node is begin if Depth > 0 then return new Node'(Bottom_Up_Tree (2 * Item - 1, Depth - 1), Bottom_Up_Tree (2 * Item, Depth - 1), Item); else return new Node'(null, null, Item); end if; end Bottom_Up_Tree; function Item_Check (This : Tree_Node) return Integer is begin if This.Left = null then return This.Item; else return This.Item + Item_Check (This.Left) - Item_Check (This.Right); end if; end Item_Check; procedure Delete_Tree (This : in out Tree_Node) is procedure Free is new Ada.Unchecked_Deallocation (Node, Tree_Node); begin if This /= null then Delete_Tree (This.Left); Delete_Tree (This.Right); Free (This); end if; end Delete_Tree; end Tree_Nodes; ---------------------------------------------------------------- -- BinaryTrees -- -- Ada 95 (GNAT) -- -- Contributed by Jim Rogers -- Modified by Simon Wright ---------------------------------------------------------------- package Tree_Nodes is type Tree_Node is private; function Bottom_Up_Tree (Item : Integer; Depth : Natural) return Tree_Node; function Item_Check (This : Tree_Node) return Integer; procedure Delete_Tree (This : in out Tree_Node); private type Node; type Tree_Node is access Node; type Node is record Left : Tree_Node; Right : Tree_Node; Item : Integer := 0; end record; end Tree_Nodes; --=-=-=--