/mobile Handheld Friendly website

 performance measurements

Each table row shows performance measurements for this Ada 2005 GNAT program with a particular command-line input value N.

 N  CPU secs Elapsed secs Memory KB Code B ≈ CPU Load
120.050.03?2167  33% 0% 50% 33%
160.770.306322167  53% 46% 76% 86%
2018.135.50163,7442167  94% 88% 73% 80%

Read the ↓ make, command line, and program output logs to see how this program was run.

Read binary-trees benchmark to see what this program should do.

 notes

GNAT 4.6

gcc version 4.8.1 (Ubuntu/Linaro 4.8.1-10ubuntu8)

 binary-trees Ada 2005 GNAT #4 program source code

--  The Computer Language Benchmarks Game
--  http://benchmarksgame.alioth.debian.org/
--
--  Based on Ada versions created by
--    Jim Rogers and Brian Drummons as well as the
--    C version by Francesco Abbate
--
--  Contributed by Brad Moore

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

   function Get_Depth return Positive is
   begin
      if Argument_Count > 0 then
         return Positive'Value (Argument (1));
      else
         return 10;
      end if;
   end Get_Depth;

   Min_Depth     : constant := 4;
   Requested_Depth : constant Positive := Get_Depth;
   Max_Depth     : constant Positive := Positive'Max (Min_Depth + 2,
                                                      Requested_Depth);
   Depth_Iterations : constant Positive := (Max_Depth - Min_Depth) / 2 + 1;

   function Get_Worker_Count return Positive is
   begin
      if Argument_Count > 1 then
         return Positive'Value (Argument (2));
      else
         --  This seems to be the sweet spot assuming max depth of 20
         return 5;
      end if;
   end Get_Worker_Count;

   Worker_Count     : constant Positive := Get_Worker_Count;

   task type Depth_Worker
     (Start, Finish : Positive := Positive'Last) is
      pragma Storage_Size (16#100#);
   end Depth_Worker;

   Results : array (1 .. Depth_Iterations) of Integer;
   Iteration_Tracking : array (1 .. Depth_Iterations) of Positive;

   task body Depth_Worker
   is
      Depth         : Natural;
      Check         : Integer;
      Iterations    : Positive;
   begin

      for Depth_Iter in Start .. Finish loop

         Depth := Min_Depth + (Depth_Iter - 1) * 2;
         Iterations := 2 ** (Max_Depth - Depth + Min_Depth);
         Iteration_Tracking (Depth_Iter) := Iterations;

         Check      := 0;

         for I in 1 .. Iterations loop
            declare
               Short_Lived_Pool : Node_Pool;
               Short_Lived_Tree_1, Short_Lived_Tree_2 : Tree_Node;
            begin

               Short_Lived_Tree_1 :=
                 Create
                   (Short_Lived_Pool,
                    Item  => I,
                    Depth => Depth);

               Short_Lived_Tree_2 :=
                  Create
                    (Short_Lived_Pool,
                     Item  => -I,
                     Depth => Depth);

               Check := Check +
                 Item_Check (Short_Lived_Tree_1) +
                 Item_Check (Short_Lived_Tree_2);
            end;
         end loop;

         Results (Depth_Iter) := Check;
      end loop;

   end Depth_Worker;

   subtype Worker_Id is Positive range 1 .. Worker_Count;

   Start_Index         : Positive := 1;
   End_Index           : Positive := Depth_Iterations;

   Iterations_Per_Task : constant Positive :=
     Depth_Iterations / Worker_Count;

   Remainder           : Natural :=
     Depth_Iterations rem Worker_Count;

   function Create_Worker return Depth_Worker is
   begin
      if Remainder = 0 then
         End_Index := Start_Index + Iterations_Per_Task - 1;
      else
         End_Index := Start_Index + Iterations_Per_Task;
         Remainder := Remainder - 1;
      end if;

      return New_Worker : Depth_Worker
        (Start => Start_Index,
         Finish => End_Index)
      do
         Start_Index := End_Index + 1;
      end return;
   end Create_Worker;

   Long_Lived_Node_Pool : Node_Pool;

   Long_Lived_Tree      : Tree_Node;

   Check : Integer;

begin

   declare
      task Stretch_Depth_Task is
      end Stretch_Depth_Task;

      task body Stretch_Depth_Task is
         Stretch_Depth : constant Positive := Max_Depth + 1;

         Pool : Trees.Node_Pool;
         Stretch_Tree : constant Tree_Node :=
           Trees.Create (Pool  => Pool,
                         Item  => 0,
                         Depth => Stretch_Depth);
      begin
         Check        := Item_Check (Stretch_Tree);
         Put ("stretch tree of depth ");
         Put (Item => Stretch_Depth, Width => 1);
         Put (HT & " check: ");
         Put (Item => Check, Width => 1);
         New_Line;
      end Stretch_Depth_Task;

      task Create_Long_Lived_Tree_Task is
      end Create_Long_Lived_Tree_Task;

      task body Create_Long_Lived_Tree_Task is
      begin
         Long_Lived_Tree := Create (Long_Lived_Node_Pool, 0, Max_Depth);
      end Create_Long_Lived_Tree_Task;
   begin
      null;
   end;

   declare
      Workers : array (Worker_Id) of Depth_Worker
        := (others => Create_Worker);
      pragma Unreferenced (Workers);
   begin
      null;
   end;

   for I in Results'Range loop
      Put (Item => Iteration_Tracking (I) * 2, Width => 0);
      Put (HT & " trees of depth ");
      Put (Item => Min_Depth + 2 * (I - 1), Width => 0);
      Put (HT & " check: ");
      Put (Item => Results (I), Width => 0);
      New_Line;
   end loop;

   Put ("long lived tree of depth ");
   Put (Item => Max_Depth, Width => 0);
   Put (HT & " check: ");
   Check := Item_Check (Long_Lived_Tree);
   Put (Item => Check, Width => 0);
   New_Line;

end Binarytrees;

--  The Computer Language Benchmarks Game
--  http://shootout.alioth.debian.org/
--
--  Based on Ada versions created by
--    Jim Rogers and Brian Drummond as well as
--    C version by Francesco Abbate
--
--  Contributed by Brad Moore

private with Ada.Finalization;
private with Apache_Runtime.Pools;

package Trees is

   type Tree_Node is private;
   function Item_Check (Item : Tree_Node) return Integer;

   type Node_Pool is limited private;

   function Create
     (Pool : Node_Pool;
      Item : Integer;
      Depth : Integer) return Tree_Node;

private

   use Apache_Runtime;

   type Node;
   type Tree_Node is access all Node;

   type Node is record
      Left  : Tree_Node;
      Right : Tree_Node;
      Value  : Integer;
   end record;

   type Node_Pool is
     new Ada.Finalization.Limited_Controlled with
      record
         Pool : aliased Pools.Pool_Type;
      end record;

   overriding procedure Initialize (Item : in out Node_Pool);
   overriding procedure Finalize   (Item : in out Node_Pool);

end Trees;

--  The Computer Language Benchmarks Game
--  http://shootout.alioth.debian.org/
--
--  Based on Ada versions created by
--    Jim Rogers and Brian Drummond as well as the
--    C version by Francesco Abbate
--
--  Contributed by Brad Moore

with Ada.Unchecked_Conversion;
with Interfaces;
with System;

package body Trees is

   Pools_Status : constant Apache_Runtime.Apr_Status :=
     Apache_Runtime.Pools.Initialize;
   pragma Unreferenced (Pools_Status);

   function New_Node (Pool : Node_Pool) return Tree_Node;

   function Create
     (Pool : Node_Pool;
      Item : Integer;
      Depth : Integer) return Tree_Node
   is
      Result : constant Tree_Node := New_Node (Pool);
   begin
      if Depth > 0 then
         Result.all := (Left => Create (Pool, 2 * Item - 1, Depth - 1),
                        Right => Create (Pool, 2 * Item, Depth - 1),
                        Value => Item);
      else
         Result.all := (Left | Right => null, Value => Item);
      end if;

      return Result;

   end Create;

   overriding procedure Finalize   (Item : in out Node_Pool) is
   begin
      Pools.Destroy (Item.Pool);
   end Finalize;

   overriding procedure Initialize (Item : in out Node_Pool) is
      Status : constant Apr_Status :=
        Pools.Create
          (New_Pool => Item.Pool'Address,
           Parent   => System.Null_Address);
      pragma Unreferenced (Status);
   begin
      null;
   end Initialize;

   function Item_Check (Item : Tree_Node) return Integer is
   begin
      if Item.Left = null then
         return Item.Value;
      else
         return Item.Value + Item_Check (Item.Left) - Item_Check (Item.Right);
      end if;
   end Item_Check;

   function New_Node (Pool : Node_Pool) return Tree_Node
   is
      function Node_Convert is new Ada.Unchecked_Conversion
        (Source => System.Address,
         Target => Tree_Node);
   begin
      return Node_Convert
        (Pools.Allocate (Pool => Pool.Pool,
                         Size => Node'Size / Interfaces.Unsigned_8'Size));
   end New_Node;
end Trees;

--  The Computer Language Benchmarks Game
--  http://shootout.alioth.debian.org/
--
--  Contributed by Brad Moore

package Apache_Runtime is
   pragma Pure;

   type Apr_Status is new Integer;

   type Apr_Size is new Integer;

end Apache_Runtime;

--  The Computer Language Benchmarks Game
--  http://shootout.alioth.debian.org/
--
--  Contributed by Brad Moore

with System;

package Apache_Runtime.Pools is

   subtype Pool_Type is System.Address;
   subtype Pool_Access is System.Address;

   function Initialize return Apr_Status;

   function Create
     (New_Pool : Pool_Access;
      Parent : Pool_Type) return Apr_Status;

   procedure Destroy (Pool : Pool_Type);

   function Allocate (Pool : Pool_Type; Size : Apr_Size) return System.Address;

private

   pragma Import (C, Initialize, "apr_initialize");
   pragma Import (C, Destroy, "apr_pool_destroy");
   pragma Import (C, Allocate, "apr_palloc");

end Apache_Runtime.Pools;

--  The Computer Language Benchmarks Game
--  http://shootout.alioth.debian.org/
--
--  Contributed by Brad Moore

package body Apache_Runtime.Pools is

   function Create_Ex
     (New_Pool : Pool_Access;
      Parent : Pool_Type;
      Reserved_1, Reserved_2 : System.Address) return Apr_Status;
   pragma Import (C, Create_Ex, "apr_pool_create_ex");

   ------------
   -- Create --
   ------------

   function Create
     (New_Pool : Pool_Access;
      Parent : Pool_Type)
      return Apr_Status
   is
   begin
      return Create_Ex
        (New_Pool,
         Parent,
         System.Null_Address,
         System.Null_Address);
   end Create;

end Apache_Runtime.Pools;

 make, command-line, and program output logs

Sat, 19 Oct 2013 17:36:28 GMT

MAKE:
/usr/bin/gnatchop -r -w binarytrees.gnat-4.gnat
splitting binarytrees.gnat-4.gnat into:
   binarytrees.adb
   trees.ads
   trees.adb
   apache_runtime.ads
   apache_runtime-pools.ads
   apache_runtime-pools.adb
/usr/bin/gnatmake -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp -f binarytrees.adb -o binarytrees.gnat-4.gnat_run -largs -lapr-1
gcc-4.6 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp binarytrees.adb
gcc-4.6 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp trees.adb
binarytrees.gnat-4.gnat:305:07: warning: possible aliasing problem for type "Tree_Node"
binarytrees.gnat-4.gnat:305:07: warning: use -fno-strict-aliasing switch for references
binarytrees.gnat-4.gnat:305:07: warning: or use "pragma No_Strict_Aliasing (Tree_Node);"
gcc-4.6 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp apache_runtime.ads
gcc-4.6 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp apache_runtime-pools.adb
gnatbind -x binarytrees.ali
gnatlink binarytrees.ali -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -o binarytrees.gnat-4.gnat_run -lapr-1
0.63s to complete and log all make actions

COMMAND LINE:
./binarytrees.gnat-4.gnat_run 20

PROGRAM OUTPUT:
stretch tree of depth 21	 check: -1
2097152	 trees of depth 4	 check: -2097152
524288	 trees of depth 6	 check: -524288
131072	 trees of depth 8	 check: -131072
32768	 trees of depth 10	 check: -32768
8192	 trees of depth 12	 check: -8192
2048	 trees of depth 14	 check: -2048
512	 trees of depth 16	 check: -512
128	 trees of depth 18	 check: -128
32	 trees of depth 20	 check: -32
long lived tree of depth 20	 check: -1

Revised BSD license

  Home   Conclusions   License   Play