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
60,0000.660.222722906  81% 72% 81% 81%
600,0004.991.451,6202906  91% 89% 89% 86%
6,000,00058.3516.091,6202906  93% 93% 93% 93%

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

Read chameneos-redux benchmark to see what this program should do.

 notes

GNATMAKE 4.6

gcc version 4.8.2 (Ubuntu 4.8.2-19ubuntu1)

 chameneos-redux Ada 2005 GNAT #5 program source code

-- The Computer Language Benchmarks Game
-- http://benchmarksgame.alioth.debian.org/
--
-- Contributed by Francois Fabien (9 septembre 2011)
--
-- Based on the original Ada version by
-- Claude Kaiser and Jean-Francois Pradat-Peyre (CEDRIC - CNAM Paris)
--
-- Chameneos are Ada tasks, mapped to OS threads.
-- The meeting place is a protected body with a requeue entry.
-- On a single-core, tests are run in sequence; on a multicore in parallel.
--
-- Expected build command:
-- gnatmake -O3  chameneosredux.adb
------------------------------------------------------------------------------
pragma Suppress (All_Checks);

pragma Restrictions (No_Abort_Statements);
pragma Restrictions (Max_Select_Alternatives => 0);
pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);

with System;           use System;
with Ada.Command_Line; use Ada.Command_Line;
with Chameneos;        use Chameneos;
with System.Task_Info;

procedure ChameneosRedux is
   pragma Priority (Max_Priority);

   -- GNU ld will remove unused sections; GNAT specific
   pragma Linker_Options ("-Wl,--gc-sections");

   Meeting_count : Meetings := 600; -- default value
begin
   if Argument_Count > 0 then
      begin
         Meeting_count := Meetings'Value (Argument (1));
      exception
         when others =>
            -- When wrong argument, keep meetings := 600
            null;
      end;
   end if;

   Chameneos.Print_Colours;
   if Task_Info.Number_Of_Processors > 1 then
      Chameneos.Run_Multicore (Meeting_count);
   else
      Chameneos.Run (Meeting_count, 3);
      Chameneos.Run (Meeting_count, 10);
   end if;
end ChameneosRedux;
------------------------------------------------------------------------------
-- Root package
-- Definitions and test procedure (run)
------------------------------------------------------------------------------

package Chameneos is

   Max_Creatures : constant := 10;

   type Meetings is range 0 .. +(2 ** 31 - 1);
   for Meetings'Size use 32; --32bits even on x64

   type Colour is (Blue, Red, Yellow);

   -- The creature Name
   type Id_Type is range 1 .. Max_Creatures;

   Max_Set : constant array (Id_Type) of Colour :=
     (Blue,
      Red,
      Yellow,
      Red,
      Yellow,
      Blue,
      Red,
      Yellow,
      Red,
      Blue);

   -- The test procedure for single core
   procedure Run (Meetings_Nbr : Meetings; Task_Nbr : Id_Type);
   -- The test procedure for multicore
   procedure Run_Multicore (Meetings_Nbr : Meetings);

   --  Ancilliary procedure used for output
   procedure Print_Colours;

   function Do_Complement (C1, C2 : Colour) return Colour;
   -- since this function is heavily used, make it inline to speed up
   pragma Inline (Do_Complement);

end Chameneos;
------------------------------------------------------------------------------
with Ada.Text_IO;           use Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Chameneos.Creatures;   use Chameneos.Creatures;

package body Chameneos is

   package Meet_Io is new Ada.Text_IO.Integer_IO (Meetings);

   type Measures is array (Id_Type range <>) of Measure_Item;

   type String_Access is access all String;

   Colour_Image : constant array (Colour) of String_Access :=
     (Blue   => new String'("blue"),
      Red    => new String'("red"),
      Yellow => new String'("yellow"));

   -- global data because of memory leak
   Numbers_Image : constant array (0 .. 9) of String_Access :=
     (0 => new String'("zero "),
      1 => new String'("one "),
      2 => new String'("two "),
      3 => new String'("three "),
      4 => new String'("four "),
      5 => new String'("five "),
      6 => new String'("six "),
      7 => new String'("seven "),
      8 => new String'("eight "),
      9 => new String'("nine "));

   function Do_Complement (C1, C2 : Colour) return Colour is
   begin
      case C1 is
         when Blue =>
            case C2 is
               when Blue =>
                  return Blue;
               when Red =>
                  return Yellow;
               when Yellow =>
                  return Red;
            end case;
         when Red =>
            case C2 is
               when Blue =>
                  return Yellow;
               when Red =>
                  return Red;
               when Yellow =>
                  return Blue;
            end case;
         when Yellow =>
            case C2 is
               when Blue =>
                  return Red;
               when Red =>
                  return Blue;
               when Yellow =>
                  return Yellow;
            end case;
      end case;
   end Do_Complement;

   function Spelled (Value : Meetings) return String is
      Result : Unbounded_String := Null_Unbounded_String;
      K      : Natural          := Natural (Value);
   begin
      loop
         Result := Numbers_Image (K rem 10).all & Result;
         K      := K / 10;
         exit when K = 0;
      end loop;
      return To_String (Result);
   end Spelled;

   procedure Join (Set : Creature_Sets) is
      Finished : Boolean := False;
      First    : Id_Type := Id_Type'First;
   begin
      while not Finished loop
         Finished := True;
         for I in First .. Set'Last loop
            if not Set (I)'Terminated then
               Finished := False;
               delay 0.001;
               exit;
            else
               First := I;
            end if;
         end loop;
      end loop;
   end Join;
   pragma Inline (Join);

   procedure Output (Measure : in Measures) is
      Total_Meetings : Meetings := 0;
   begin
      for I in Measure'Range loop
         Put (Colour_Image (Max_Set (I)).all & " ");
      end loop;
      New_Line;
      for I in Measure'Range loop
         Total_Meetings := Total_Meetings + Measure (I).Meetings_Made;
         Meet_Io.Put (Measure (I).Meetings_Made, Width => 10);
         Put_Line ("  " & Spelled (Measure (I).Meetings_Same));
      end loop;

      Put (Spelled (Total_Meetings));
      New_Line (2);
   end Output;

   procedure Run (Meetings_Nbr : Meetings; Task_Nbr : Id_Type) is

      Creature_Set : Creature_Sets (1 .. Task_Nbr);
      Measure      : Measures (1 .. Task_Nbr);
   begin
      -- Meeting Place initialization
      Init_Mall (1, Meetings_Nbr);
      -- launch the tasks
      for I in 1 .. Task_Nbr loop
         Creature_Set (I).Start (1, I, Max_Set (I));
      end loop;

      -- Rendez-vous : Waiting for the the completion of tasks
      for I in 1 .. Task_Nbr loop
         Creature_Set (I).Report (Measure (I));
      end loop;
      Join (Creature_Set);
      Output (Measure);

   end Run;

   procedure Run_Multicore (Meetings_Nbr : Meetings) is

      Creature_Set_3  : Creature_Sets (1 .. 3);
      Measure_3       : Measures (1 .. 3);
      Creature_Set_10 : Creature_Sets (1 .. 10);
      Measure_10      : Measures (1 .. 10);

   begin
      -- initialization of the 2 Meeting Places
      Init_Mall (1, Meetings_Nbr);
      Init_Mall (2, Meetings_Nbr);
      -- launch the tasks
      for I in Id_Type range 1 .. 3 loop
         Creature_Set_3 (I).Start (1, I, Max_Set (I));
      end loop;
      for I in Id_Type range 1 .. 10 loop
         Creature_Set_10 (I).Start (2, I, Max_Set (I));
      end loop;

      -- Rendez-vous : Waiting for the the completion of tasks
      for I in Id_Type range 1 .. 10 loop
         Creature_Set_10 (I).Report (Measure_10 (I));
      end loop;
      Join (Creature_Set_10);
      for I in Id_Type range 1 .. 3 loop
         Creature_Set_3 (I).Report (Measure_3 (I));
      end loop;
      Join (Creature_Set_3);

      Output (Measure_3);
      Output (Measure_10);

   end Run_Multicore;

   procedure Print_Colours is
      procedure Print_One_Line (C1, C2 : Colour) is
      begin
         Put_Line
           (Colour_Image (C1).all &
            " + " &
            Colour_Image (C2).all &
            " -> " &
            Colour_Image (Do_Complement (C1, C2)).all);
      end Print_One_Line;
   begin
      for Self in Colour loop
         for Other in Colour loop
            Print_One_Line (Self, Other);
         end loop;
      end loop;
      New_Line;
   end Print_Colours;

end Chameneos;
------------------------------------------------------------------------------
-- The chameneos description
------------------------------------------------------------------------------
with System;

package Chameneos.Creatures is

   type Place_Index is range 1 .. 2;

   -- Stuff required for the measurement
   type Measure_Item is record
      Meetings_Made : Meetings := 0;
      Meetings_Same : Meetings := 0;
   end record;

   --A chameneos is an Ada task
   task type Creature is
      pragma Priority (System.Default_Priority);
      pragma Storage_Size (31000);
      entry Start
        (Place_Nbr : in Place_Index;
         Id        : in Id_Type;
         C         : in Colour);
      entry Report (Item : out Measure_Item);
   end Creature;

   type Creature_Sets is array (Id_Type range <>) of Creature;

   procedure Init_Mall (Place_Nbr : Place_Index; Max_Count : in Meetings);

end Chameneos.Creatures;
------------------------------------------------------------------------------

package body Chameneos.Creatures is

   -- specification of the meeting place where 2 tasks transfer Id.
   -- the entry point is Meet for all tasks, the first incoming task is
   -- requeued at the Waiting entry.

   protected type Places is
      procedure Init (Max_Count : in Meetings);
      entry Meet
        (X           : in Id_Type;
         C           : in Colour;
         Mall_Open   : out Boolean;
         Name_Other  : out Id_Type;
         Color_Other : out Colour);

   private
      entry Waiting
        (X           : in Id_Type;
         C           : in Colour;
         Mall_Open   : out Boolean;
         Name_Other  : out Id_Type;
         Color_Other : out Colour);

      First_Call, Ready  : Boolean;
      A_Colour, B_Colour : Colour;
      A_Name, B_Name     : Id_Type;
      Meetings_Counter   : Meetings;
   end Places;

   Place : array (Place_Index) of Places;

   task body Creature is
      My_Place                : Place_Index;
      My_ID, Other_Id         : Id_Type;
      My_Colour, Other_Colour : Colour;
      L_Measure               : Measure_Item := (0, 0);
      Is_Mall_Open            : Boolean;
   begin
      accept Start (
        Place_Nbr  : in Place_Index;
         Id        : in Id_Type;
         C         : in Colour) do
         My_Place  := Place_Nbr;
         My_ID     := Id;
         My_Colour := C;
      end Start;

      loop

         Place (My_Place).Meet
           (My_ID,
            My_Colour,
            Is_Mall_Open,
            Other_Id,
            Other_Colour);
         if not Is_Mall_Open then
            -- the test is finished
            exit;
         end if;
         My_Colour               := Do_Complement (My_Colour, Other_Colour);
         L_Measure.Meetings_Made := L_Measure.Meetings_Made + 1;
         if Other_Id = My_ID then
            L_Measure.Meetings_Same := L_Measure.Meetings_Same + 1;
         end if;

      end loop;

      -- Give the results and die.
      accept Report (Item : out Measure_Item) do
         Item := L_Measure;
      end Report;
   end Creature;

   protected body Places is

      procedure Init (Max_Count : in Meetings) is
      begin
         Meetings_Counter := Max_Count;
         First_Call       := True;
         Ready            := True;
      end Init;

      entry Meet
        (X           : in Id_Type;
         C           : in Colour;
         Mall_Open   : out Boolean;
         Name_Other  : out Id_Type;
         Color_Other : out Colour) when Ready
      is
      begin
         if (Meetings_Counter = 0) then
            -- The test is finished
            Mall_Open := False;
            -- must give dummy values that will not be used anyway
            Name_Other  := 1;
            Color_Other := Red;
            return;
         end if;
         Mall_Open := True;
         if (First_Call) then
            First_Call := False;
            A_Name     := X;
            A_Colour   := C;
            requeue Waiting;
         else
            Meetings_Counter := Meetings_Counter - 1;
            B_Name           := X;
            B_Colour         := C;
            Name_Other       := A_Name;
            Color_Other      := A_Colour;
            Ready            := False; -- block next incoming task
            First_Call       := True;  -- enable Waiting entry
         end if;
      end Meet;

      entry Waiting
        (X           : in Id_Type;
         C           : in Colour;
         Mall_Open   : out Boolean;
         Name_Other  : out Id_Type;
         Color_Other : out Colour) when First_Call
      is
         pragma Unreferenced (X, C);
      begin
         Mall_Open   := True;
         Name_Other  := B_Name;
         Color_Other := B_Colour;
         Ready       := True; --enable Meet entry
      end Waiting;
   end Places;

   procedure Init_Mall (Place_Nbr : Place_Index; Max_Count : in Meetings) is
   begin
      Place (Place_Nbr).Init (Max_Count);
   end Init_Mall;

end Chameneos.Creatures;

 make, command-line, and program output logs

Sat, 26 Apr 2014 15:52:33 GMT

MAKE:
/usr/bin/gnatchop -r -w chameneosredux.gnat-5.gnat
splitting chameneosredux.gnat-5.gnat into:
   chameneosredux.adb
   chameneos.ads
   chameneos.adb
   chameneos-creatures.ads
   chameneos-creatures.adb
/usr/bin/gnatmake -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp -f chameneosredux.adb -o chameneosredux.gnat-5.gnat_run 
gcc-4.6 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp chameneosredux.adb
gcc-4.6 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp chameneos.adb
gcc-4.6 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp chameneos-creatures.adb
gnatbind -x chameneosredux.ali
gnatlink chameneosredux.ali -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -o chameneosredux.gnat-5.gnat_run
1.46s to complete and log all make actions

COMMAND LINE:
./chameneosredux.gnat-5.gnat_run 6000000

PROGRAM OUTPUT:
blue + blue -> blue
blue + red -> yellow
blue + yellow -> red
red + blue -> yellow
red + red -> red
red + yellow -> blue
yellow + blue -> red
yellow + red -> blue
yellow + yellow -> yellow

blue red yellow 
   3794302  zero 
   3801746  zero 
   4403952  zero 
one two zero zero zero zero zero zero 

blue red yellow red yellow blue red yellow red blue 
    860781  zero 
    851388  zero 
   2491270  zero 
    859446  zero 
    865624  zero 
    857739  zero 
    862207  zero 
    857240  zero 
    867898  zero 
   2626407  zero 
one two zero zero zero zero zero zero 

Revised BSD license

  Home   Conclusions   License   Play