The Computer Language
Benchmarks Game

binary-trees Ada 2005 GNAT #3 program

source code

-- The Computer Language Benchmarks Game
-- http://benchmarksgame.alioth.debian.org/
--
-- Contributed by Jim Rogers
-- Modified by Brian Drummond

with Treenodes; use Treenodes;
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;

procedure Binarytrees is
   -- Change "CPUs" to control number of tasks created
   CPUs : constant Positive := 4;
   BlockSize : Positive;
   Min_Depth : constant Positive := 4;
   N : Natural := 1;
   Stretch_Tree : TreeNode;
   Long_Lived_Tree : TreeNode;
   Max_Depth : Positive;
   Stretch_Depth : Positive;
   Iteration : Positive;
   Iterations : Positive;
   Sum : Integer;
   Check : Integer;
   Depth : Natural;

   task type check_this_depth is
      entry Start(Iteration, Size : Positive; To_Depth :in Natural);
      entry Complete(Result : out Integer);
   end check_this_depth;

   task body check_this_depth is
      Check : Integer;
      Sum : Integer;
      Depth : Natural;
      First : Positive;
      Last : Positive;
      Short_Lived_Tree_1 : TreeNode;
      Short_Lived_Tree_2 : TreeNode;

   begin
      loop
         select
            accept Start(Iteration, Size : Positive; To_Depth :in Natural) do
               First := Iteration;
               Last := Iteration + Size - 1;
               Depth := To_Depth;
            end Start;
            Check := 0;
            for I in First .. Last loop
               Short_Lived_Tree_1 := Bottom_Up_Tree(Item => I, Depth => Depth);
               Short_Lived_Tree_2 := Bottom_Up_Tree(Item =>-I, Depth => Depth);
               Item_Check(Short_Lived_Tree_1, Sum);
               Check := Check + Sum;
               Item_Check(Short_Lived_Tree_2, Sum);
               Check := Check + Sum;
            end loop;
            accept Complete(Result : out Integer) do
               Result := Check;
            end Complete;
         or
            Terminate;
         end select;
      end loop;
   end check_this_depth;

   subtype Task_Count is positive range 1 .. CPUs;	
   Tasks : array (Task_Count) of check_this_depth;

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);
   Item_Check(Stretch_Tree, Check);
   Put("stretch tree of depth ");
   Put(Item => Stretch_Depth, Width => 1);
   Put(Ht & " check: ");
   Put(Item => Check, Width => 1);
   New_Line;
   
   Long_Lived_Tree := Bottom_Up_Tree(0, Max_Depth);
   
   Depth := Min_Depth;
   while Depth <= Max_Depth loop
      Iterations := 2**(Max_Depth - Depth + Min_Depth);
      Check := 0;

-- Setup tasking parameters for reasonable task granularity
-- Too large and we can't balance CPU loads
-- Too small and we waste time in task switches
-- Not very critical - anything more complex is probably a waste of effort
      
      BlockSize := 2**10;
      if Iterations < BlockSize * CPUs then
         BlockSize := 1;
      end if;
  
-- Check that Iterations is a multiple of Blocksize * CPUs
-- Error out otherwise (dealing with remainder is trivial but tedious)
      Pragma Assert(Iterations mod( BlockSize * CPUs) = 0, 
                            "Iteration count not supported!");

      -- for I in 1..Iterations loop  
      Iteration := 1;   
      while Iteration <= Iterations loop
         for j in Task_Count loop
            Tasks(j).Start(Iteration, Blocksize, Depth);
            Iteration := Iteration + BlockSize;
         end loop;
         for j in Task_Count loop
            Tasks(j).Complete(Sum);
            Check := Check + Sum;
         end loop;
      end loop;
      Put(Item => Iterations * 2, Width => 0);
      Put(Ht & " trees of depth ");
      Put(Item => Depth, Width => 0);
      Put(Ht & " check: ");
      Put(Item => Check, Width => 0);
      New_Line;
      Depth := Depth + 2;
   end loop;
   Put("long lived tree of depth ");
   Put(Item => Max_Depth, Width => 0);
   Put(Ht & " check: ");
   Item_Check(Long_Lived_Tree, Check);
   Put(Item => Check, Width => 0);
   New_Line;
end Binarytrees;

-- The Computer Language Benchmarks Game
-- http://shootout.alioth.debian.org/
--
-- Contributed by Jim Rogers
-- Modified by Brian Drummond

package Treenodes is
   type Treenode is private;
   function Bottom_Up_Tree(Item : Integer; Depth : Integer) return Treenode;
   procedure Item_Check(This : in out Treenode; Sum : out Integer);
private
   type Node;
   type Treenode is access Node;
   type Node is record
      Left  : Treenode := null;
      Right : Treenode := null;
      Item  : Integer  := 0; 
   end record;
end Treenodes;

-- The Computer Language Benchmarks Game
-- http://shootout.alioth.debian.org/
--
-- Contributed by Jim Rogers
-- Modified by Brian Drummond

with Ada.Unchecked_Deallocation;

package body Treenodes is
   function Bottom_Up_Tree(Item : Integer; Depth : Integer)
      return Treenode 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;

   procedure Item_Check (This : in out Treenode; Sum : out Integer) is
      procedure Free is new Ada.Unchecked_Deallocation(Node, Treenode);
      Left_Sum, Right_Sum : Integer;
   begin
      if This.Left = null then
         Sum := This.Item;
      else
         Item_Check(This.Left, Left_Sum);
         Item_Check(This.Right, Right_Sum);
         Sum :=  This.Item + Left_Sum - Right_Sum;
      end if;
      Free(This);      
   end Item_Check;

end Treenodes;

    

notes, command-line, and program output

NOTES:
64-bit Ubuntu quad core
GNATMAKE 5.4.0
gcc (Ubuntu 5.4.0-6ubuntu1~16.04.4) 5.4.0 20160609



Sat, 25 Mar 2017 00:56:07 GMT

MAKE:
gnatchop -r -w binarytrees.gnat-3.gnat
splitting binarytrees.gnat-3.gnat into:
   binarytrees.adb
   treenodes.ads
   treenodes.adb
gnatmake -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp -f binarytrees.adb -o binarytrees.gnat-3.gnat_run -largs -lapr-1
gcc-5 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp binarytrees.adb
gcc-5 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp treenodes.adb
gnatbind-5 -x binarytrees.ali
gnatlink-5 binarytrees.ali -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -o binarytrees.gnat-3.gnat_run -lapr-1
3.40s to complete and log all make actions

COMMAND LINE:
./binarytrees.gnat-3.gnat_run 7

UNEXPECTED OUTPUT 

1,4c1,4
< stretch tree of depth 8	 check: -1
< 256	 trees of depth 4	 check: -256
< 64	 trees of depth 6	 check: -64
< long lived tree of depth 7	 check: -1
---
> stretch tree of depth 8	 check: 511
> 128	 trees of depth 4	 check: 3968
> 32	 trees of depth 6	 check: 4064
> long lived tree of depth 7	 check: 255

PROGRAM OUTPUT:
stretch tree of depth 8	 check: -1
256	 trees of depth 4	 check: -256
64	 trees of depth 6	 check: -64
long lived tree of depth 7	 check: -1