The Q6600
Benchmarks Game

binary-trees Ada 2012 GNAT #3 program

source code

-- The Computer Language Benchmarks Game
-- https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
--
-- Contributed by Jim Rogers
-- Modified by Brian Drummond
-- *reset*

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(Depth => Depth);
               Item_Check(Short_Lived_Tree_1, 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(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(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, 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
-- https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
--
-- Contributed by Jim Rogers
-- Modified by Brian Drummond

package Treenodes is
   type Treenode is private;
   function Bottom_Up_Tree(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; 
   end record;
end Treenodes;

-- The Computer Language Benchmarks Game
-- https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
--
-- Contributed by Jim Rogers
-- Modified by Brian Drummond

with Ada.Unchecked_Deallocation;

package body Treenodes is
   function Bottom_Up_Tree(Depth : Integer)
      return Treenode is
   begin
      if Depth > 0 then
         return new Node'(Bottom_Up_Tree(Depth -1),
            Bottom_Up_Tree(Depth -1));
      else
         return new Node'(null, null);
      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 := 1;
      else
         Item_Check(This.Left, Left_Sum);
         Item_Check(This.Right, Right_Sum);
         Sum :=  1 + 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 9.3.0
gcc (Ubuntu 9.3.0-10ubuntu2) 9.3.0



Mon, 04 May 2020 17:15:02 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=core2 -gnatNp -f binarytrees.adb -o binarytrees.gnat-3.gnat_run -largs -lapr-1
x86_64-linux-gnu-gcc-9 -c -O3 -fomit-frame-pointer -march=core2 -gnatNp binarytrees.adb
x86_64-linux-gnu-gcc-9 -c -O3 -fomit-frame-pointer -march=core2 -gnatNp treenodes.adb
x86_64-linux-gnu-gnatbind-9 -x binarytrees.ali
x86_64-linux-gnu-gnatlink-9 binarytrees.ali -O3 -fomit-frame-pointer -march=core2 -o binarytrees.gnat-3.gnat_run -lapr-1

5.22s to complete and log all make actions

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

PROGRAM OUTPUT:
stretch tree of depth 22	 check: 8388607
2097152	 trees of depth 4	 check: 65011712
524288	 trees of depth 6	 check: 66584576
131072	 trees of depth 8	 check: 66977792
32768	 trees of depth 10	 check: 67076096
8192	 trees of depth 12	 check: 67100672
2048	 trees of depth 14	 check: 67106816
512	 trees of depth 16	 check: 67108352
128	 trees of depth 18	 check: 67108736
32	 trees of depth 20	 check: 67108832
long lived tree of depth 21	 check: 4194303