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,000Make Error  6001   

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.9.2

gcc version 4.9.2 (Ubuntu 4.9.2-10ubuntu13)

 chameneos-redux Ada 2005 GNAT #2 program source code

-- The Computer Language Benchmarks Game
-- http://benchmarksgame.alioth.debian.org/
--
-- Contributed by Pat Rogers
--
-- Based on the C++ version by Andrew Moon 
-- and the C version by Dmitry Vyukov
--
-- A task (thread) is created for each chameneous.
-- An atomic compare-and-swap operation is used
-- for shared state manipulation.  A protected 
-- type is used for completion notification.
-- A cache-aligned memory allocator is used.


-- Expected build command:
-- gnatmake -gnatp  -gnatn  -fstrict-aliasing -O3 -fomit-frame-pointer -march=native -ffunction-sections -fdata-sections -f chameneosredux.adb -o chameneosredux.gnat_run   -largs -Wl,--gc-sections



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

with Chameneos.Games;       use Chameneos.Games;
with Ada.Command_Line;      use Ada.Command_Line;
with Chameneos.Processors;  use Chameneos.Processors;

procedure ChameneosRedux is

   use Chameneos;

   N : Meeting_Count;

   Game1_Creature_Colors : constant Color_List_Ref := new Color_List'(Blue, Red, Yellow);

   Game2_Creature_Colors : constant Color_List_Ref :=
      new Color_List'(Blue, Red, Yellow, Red, Yellow, Blue, Red, Yellow, Red, Blue);

   Game1 : Game (Num_Creatures => Game1_Creature_Colors'Length);

   Game2 : Game (Num_Creatures => Game2_Creature_Colors'Length);

begin
   Print_Color_Complements;

   if Argument_Count < 1 then
      N := 6_000_000;
   else
      N := Meeting_Count'Value (Argument (1));
   end if;

   if Processor_Count < 4 then  -- run the games sequentially
      Game1.Start (Game1_Creature_Colors, N, Slot => 0);
      Game1.Await_Completion;

      Game2.Start (Game2_Creature_Colors, N, Slot => 0);
      Game2.Await_Completion;
   else -- run the games in parallel
      Game1.Start (Game1_Creature_Colors, N, Slot => 1);
      Game2.Start (Game2_Creature_Colors, N, Slot => 2);

      Game1.Await_Completion;
      Game2.Await_Completion;
   end if;

   Game1.Display;
   Game2.Display;
end ChameneosRedux;

-------------------------------------------------------------------------------

with Interfaces;                  use Interfaces;
with Cache_Aligned_Storage_Pools; use Cache_Aligned_Storage_Pools;

package Chameneos is

   Storage : Cache_Aligned_Storage_Pool;
   --  All allocators use this common pool, which is really just a wrapper for
   --  the system allocator, but with additional constraints on the addresses
   --  returned.

   type String_Access is access all String;
   for String_Access'Storage_Pool use Storage;

   type Colors is (Blue, Red, Yellow);

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

   type Colors_Complements is array (Colors, Colors) of Colors;

   Complementary_Color : constant Colors_Complements :=
                           (Blue   => (Blue   => Blue,
                                       Red    => Yellow,
                                       Yellow => Red),
                            Red    => (Red    => Red,
                                       Blue   => Yellow,
                                       Yellow => Blue),
                            Yellow => (Yellow => Yellow,
                                       Blue   => Red,
                                       Red    => Blue));

   --  Print the Complementary_Color map
   procedure Print_Color_Complements;

   --  Returns a string representing the non-negative integer Value, in which
   --  each digit of Value is spelled out as a distinct word
   function Spelled (Value : Natural) return String;


   type Color_List is array (Positive range <>) of Colors;

   type Color_List_Ref is access constant Color_List;
   for Color_List_Ref'Storage_Pool use Storage;


   --  The efficiency of this design is due to the underlying use of a single
   --  variable (per game) shared amongst all the creature threads. This
   --  variable is used both for the count of the number of meetings completed
   --  as well as an indication of the creatures present for meetings. Hence
   --  some of the bits are used for the meeting count and some for the
   --  creatures. The number of bits used for the creature mask, in combination
   --  with the total number of bits in the shared variable, determine how many
   --  creatures and how many total meetings are supported.

   --  The number of bits allocated within the shared variable for identifying
   --  creatures
   Creature_Mask_Bits : constant := 4;

   subtype Creature_Count is Unsigned_32 range 0 .. 2 ** Creature_Mask_Bits - 1;

   --  The number of bits allocated within the shared variable for tracking the
   --  total number of meetings completed
   Meetings_Bits : constant := Unsigned_32'Size - Creature_Mask_Bits;

   Max_Meetings : constant := 2 ** Meetings_Bits - 1;

   subtype Meeting_Count is Unsigned_32 range 0 .. Max_Meetings;

end Chameneos;

-------------------------------------------------------------------------------

with Chameneos.Meetings;
with Chameneos.Countdown;
with Chameneos.Processors;

with System.Task_Info;  use System.Task_Info;

package Chameneos.Creatures is

   type Creature (Starting_Color : Colors) is tagged limited private;
   --  Each creature has an initial color, but their current color is a function
   --  of the colors of the other creatures met.

   type Creature_Ref is access all Creature;
   for Creature_Ref'Storage_Pool use Chameneos.Storage;

   --  Tell the creature where all the creatures in the game are meeting, where
   --  to signal when the creature is finished, and which slot to execute in.
   procedure Start (This     : access Creature;
                    Location : Chameneos.Meetings.Venue;
                    Latch    : Chameneos.Countdown.Latch_Ref;
                    Slot     : Natural);

   --  The caller side of the rendezvous
   procedure Meet (This : in out Creature;  Other : in out Creature);

   --  The called side of the rendezvous
   procedure Wait_Until_Met (This : in out Creature);

   procedure Await_Completion (This : in out Creature);

   procedure Set_Id (This : in out Creature;  To : Creature_Count);

   function Id (This : Creature) return Creature_Count;

   function Current_Color (This : Creature) return Colors;

   function Initial_Color (This : Creature) return Colors;

   procedure Display (This : in out Creature);

   function Total_Met (This : Creature) return Natural;

   pragma Inline (Set_Id, Id, Current_Color, Initial_Color, Total_Met);

private

   use Chameneos.Processors;

   --  Objects of type Thread implement the active execution, i.e., the
   --  symmetric rendezvous requirement, for their corresponding creatures.
   --  Each thread instance has a discriminant designating the corresponding
   --  creature. No state is maintained within the threads themselves. Each
   --  thread instance executes in a given "slot" that specifies the cores it
   --  can run upon, via processor affinities. The specific slot is also given
   --  via discriminant.
   task type Thread (This : access Creature;  Slot : Natural) is
      pragma Task_Info (new Thread_Attributes'(CPU_Affinity => Affinity (Slot)));
   end Thread;

   type Thread_Ref is access all Thread;
   for Thread_Ref'Storage_Pool use Chameneos.Storage;

   type Creature (Starting_Color : Colors) is tagged limited
      record
         Met              : Boolean := False;
         --  Met is set by other threads so the pragma is essential
         pragma Volatile (Met);
         Count            : Natural := 0;
         Same_Count       : Natural := 0;
         Color            : Colors := Starting_Color;
         Id               : Creature_Count;
         Rendezvous_Point : Meetings.Venue;
         Completion       : Chameneos.Countdown.Latch_Ref;
      end record;

end Chameneos.Creatures;

-------------------------------------------------------------------------------

with Chameneos.Creatures;  use Chameneos.Creatures;
with Chameneos.Meetings;
with Chameneos.Countdown;

package Chameneos.Games is

   type Game (Num_Creatures : Creature_Count) is tagged limited private;

   --  Allocates the creature threads and all other required data.
   procedure Start
     (This            : in out Game;
      Creature_Colors : Color_List_Ref;
      Num_Meetings    : Meeting_Count;
      Slot            : Natural);

   --  Waits for all creatures (threads) to finish.
   procedure Await_Completion (This : Game);

   procedure Display (This : Game);

private

   use Chameneos;

   type Creatures_List is array (Creature_Count range <>) of Creature_Ref;

   type Game (Num_Creatures : Creature_Count) is tagged limited
      record
         --  where all the creatures in the game meet
         Rendezvous_Point : Meetings.Venue;
         --  all the creatures in the game
         Players : Creatures_List (1 .. Num_Creatures);
         --  the common mechanism used for signalling creature completion
         Latch : aliased Countdown.Latch (Num_Creatures);
      end record;

end Chameneos.Games;

-------------------------------------------------------------------------------

limited with Chameneos.Creatures;

package Chameneos.Meetings is

   type Place (Meetings_Expected : Meeting_Count) is tagged limited private;
   --  Where creatures come to meet other creatures, potentially change colors,
   --  and play the game. Creatures are required to meet until the required
   --  number of total meetings has occurred. This number of required meetings
   --  is specified by the discriminant Meetings_Expected.

   type Venue is access all Place;
   for Venue'Storage_Pool use Chameneos.Storage;

   --  Assign a location for the creature designated by Player, within This place,
   --  for the purpose of meeting any other creatures willing to meet.
   procedure Register
     (This   : in out Place;
      Player : access Chameneos.Creatures.Creature);

   --  Have creature Player iteratively meet other creatures with This place,
   --  updating the count of the total number of creature meetings as they
   --  occur, and updating individual creature states as well (including
   --  individual meeting counts and color changes).
   procedure Meet_Others
     (This   : in out Place;
      Player : access Chameneos.Creatures.Creature);

private

   type Creature_Reference_List is
     array (Creature_Count range 1 .. Creature_Count'Last) of
        access Chameneos.Creatures.Creature;

   subtype Valid_Creature_Id is
     Creature_Count range 1 .. Creature_Count'Last;

   No_Creature : constant Creature_Count := Valid_Creature_Id'First - 1;
   --  used in Meet_Others to determine whether any creatures are waiting

   type Place (Meetings_Expected : Meeting_Count) is tagged limited
      record
         Id_Generator : Valid_Creature_Id := Valid_Creature_Id'First;
         --  Used to assign unique id's to creature threads as they register.
         Shared_State : aliased Unsigned_32 := Shift_Left (Meetings_Expected, Creature_Mask_Bits);
         --  The essential aspect of this program's design is the use of this
         --  shared variable accessed by all the creature threads in a given
         --  game. This variable is used both for the count of the number of
         --  meetings completed as well as an indication of creatures waiting
         --  for meetings. Hence the initial value is the number of required
         --  meetings, shifted into the dedicated bits, with no creatures yet
         --  waiting.
         pragma Volatile (Shared_State);
         --  Shared_State is accessed and modified by all the threads within a
         --  given game, so the pragma is essential!
         Registered_Players : Creature_Reference_List;
      end record;

end Chameneos.Meetings;

-------------------------------------------------------------------------------

with System.Storage_Pools;
with System.Storage_Elements;

package Cache_Aligned_Storage_Pools is

   package SSE renames System.Storage_Elements;
   package SSP renames System.Storage_Pools;

   type Cache_Aligned_Storage_Pool is
     new SSP.Root_Storage_Pool with private;
   --  A Cache_Aligned_Storage_Pool is a wrapper for the underlying operating
   --  system storage allocator. Allocations using pool objects of this type
   --  will return addresses that are aligned with the cache line size specified
   --  below.

   Cache_Line_Size : constant := 64;
   --  The length of a cache line on this machine.  Change as necessary...

   --  Allocates a block of storage such that Storage_Address is aligned with
   --  Cache_Line_Size. Uses the system memory allocator to do the actual
   --  allocation but asks for more storage than Requested_Size so that an
   --  aligned address within the allocated block can be found.
   procedure Allocate
     (Pool            : in out Cache_Aligned_Storage_Pool;
      Storage_Address : out System.Address;
      Requested_Size  : SSE.Storage_Count;
      Alignment       : SSE.Storage_Count);

   --  Uses the system memory routine to deallocate the entire block of storage
   --  in which Storage_Address is contained.
   procedure Deallocate
     (Pool            : in out Cache_Aligned_Storage_Pool;
      Storage_Address : System.Address;
      Requested_Size  : SSE.Storage_Count;
      Alignment       : SSE.Storage_Count);

   --  Returns a meaningless number since the system memory allocation and
   --  deallocation routines are used.
   function Storage_Size (Pool : Cache_Aligned_Storage_Pool)
      return SSE.Storage_Count;

private

   procedure Allocate_Any
     (Pool            : in out Cache_Aligned_Storage_Pool'Class;
      Storage_Address : out System.Address;
      Requested_Size  : SSE.Storage_Count;
      Alignment       : SSE.Storage_Count);

   procedure Deallocate_Any
     (Pool            : in out Cache_Aligned_Storage_Pool'Class;
      Storage_Address : System.Address;
      Requested_Size  : SSE.Storage_Count;
      Alignment       : SSE.Storage_Count);

   type Cache_Aligned_Storage_Pool is
     new SSP.Root_Storage_Pool with null record;  -- just a wrapper...

end Cache_Aligned_Storage_Pools;

-------------------------------------------------------------------------------

package Chameneos.Countdown is

   --  "Latch" is a non-cyclic traditional barrier abstraction. As a barrier it
   --  provides a means of blocking callers to Wait until a specified number of
   --  calls to Signal have occurred. At that point all of the prior calls to
   --  Wait are allowed to execute and, therefore, their callers are no longer
   --  blocked. The number of required calls to Signal is specified on a
   --  per-object basis via discriminant when objects of the type are declared.
   --  Latch is "non-cyclic", i.e., it does not block another set of waiters
   --  after the first set is allowed to continue, because there is no
   --  requirement in this application for cyclic behavior.
   protected type Latch (Signallers : Creature_Count) is
      entry Wait;
      procedure Signal;
   private
      Count : Unsigned_32 := Signallers;
   end Latch;

   type Latch_Ref is access all Latch;
   for Latch_Ref'Storage_Pool use Chameneos.Storage;

end Chameneos.Countdown;

-------------------------------------------------------------------------------

with System.Task_Info;     use System.Task_Info;
pragma Warnings (Off);
with System.OS_Interface;  use System.OS_Interface;
pragma Warnings (On);

package Chameneos.Processors is
   pragma Elaborate_Body;

   Processor_Count : constant Positive := System.Task_Info.Number_Of_Processors;

   Max_Slots : constant := 33;

   --  Returns a bit mask indicating the cores on which a thread in Slot can
   --  execute. A game is assigned to a given slot, and as a result all the
   --  threads within that game will execute only on those cores, for the sake
   --  of locality (ie performance).
   function Affinity (Slot : Natural) return CPU_Set;

   --  Each slot has an affinity mask consisting of a pair of cores
   --  dedicated to that slot, except for slot 0 which is the global mask
   --  returned by the OS (which shows all processors available).
   --
   --  For example, imagine that we get a mask with the first 8 bits
   --  enabled, indicating that 8 processors (cores) are available.
   --  The resulting data structure would be as follows:
   --
   --                     bit#
   --   slot #         123456789...
   --     0            1111111100
   --     1            1100000000
   --     2            0011000000
   --     3            0000110000
   --     4            0000001100
   --     5            1100000000
   --     6            0011000000
   --    ...              ...

end Chameneos.Processors;

-------------------------------------------------------------------------------

with Interfaces;   use Interfaces;

package x86_Atomic_Swap_Utils is

   -- Perform an atomic compare and swap: if the current value of
   -- Destination.all is Comparand, then write New_Value into Destination.all.
   -- Returns the content of Destination.all before the operation.
   function Sync_Val_Compare_And_Swap
     (Destination : access Unsigned_32;
      Comparand   : Unsigned_32;
      New_Value   : Unsigned_32)
      return Unsigned_32;

   pragma Inline_Always (Sync_Val_Compare_And_Swap);

end x86_Atomic_Swap_Utils;

-------------------------------------------------------------------------------

with GNAT.IO; use GNAT.IO;
with Ada.Strings.Unbounded;

package body Chameneos is

   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"));

   -------------
   -- Spelled --
   -------------

   function Spelled (Value : Natural) return String is
      use Ada.Strings.Unbounded;
      Result : Unbounded_String;
      K      : Natural := Value;
   begin
      loop
         Insert (Result, 1, Numbers_Image (K rem 10).all);
         K := K / 10;
         exit when K = 0;
      end loop;
      return To_String (Result);
   end Spelled;

   -------------------------
   -- Print_Color_Changes --
   -------------------------

   procedure Print_Color_Complements is
   begin
      for Self in Colors loop
         for Other in Colors loop
            Put_Line (Colors_Image (Self).all & " + " &
                      Colors_Image (Other).all & " -> " &
                      Colors_Image (Complementary_Color (Self, Other)).all);
         end loop;
      end loop;
      New_Line;
   end Print_Color_Complements;

end Chameneos;

-------------------------------------------------------------------------------

with GNAT.IO;  use GNAT.IO;

package body Chameneos.Creatures is

   -----------
   -- Start --
   -----------

   procedure Start
     (This     : access Creature;
      Location : Chameneos.Meetings.Venue;
      Latch    : Chameneos.Countdown.Latch_Ref;
      Slot     : Natural)
   is
      Player_To_Be_Named_Later : Thread_Ref;
      pragma Unreferenced (Player_To_Be_Named_Later);
   begin
      This.Rendezvous_Point := Location;
      This.Completion := Latch;
      This.Rendezvous_Point.Register (This);
      Player_To_Be_Named_Later := new Thread (This, Slot);
        --  just launch the thread, no need to keep track of it
   end Start;

   ----------
   -- Meet --
   ----------

   procedure Meet (This : in out Creature; Other : in out Creature) is
      New_Color : Colors;
   begin
      if This.Id = Other.Id then
         This.Same_Count := This.Same_Count + 1;
         Other.Same_Count := Other.Same_Count + 1;
      end if;

      This.Count  := This.Count + 1;
      Other.Count := Other.Count + 1;

      New_Color := Complementary_Color (This.Color, Other.Color);
      This.Color := New_Color;
      Other.Color := New_Color;

      Other.Met := True;
   end Meet;

   --------------------
   -- Wait_Until_Met --
   --------------------

   procedure Wait_Until_Met (This : in out Creature) is
   begin
      if Processor_Count > 1 then
         declare
            Spin_Count : Integer := 0;
         begin
            while not This.Met loop
               Spin_Count := Spin_Count + 1;
               if Spin_Count > 20_000 then  -- arbitrary max
                  delay 0.0;  -- yield
                  Spin_Count := 0;
               end if;
            end loop;
         end;
      else
         while not This.Met loop
            delay 0.0; -- yield
         end loop;
      end if;
      This.Met := False;
   end Wait_Until_Met;

   ----------------------
   -- Await_Completion --
   ----------------------

   procedure Await_Completion (This : in out Creature) is
   begin
      This.Completion.Wait;
   end Await_Completion;

   ------------
   -- Set_Id --
   ------------

   procedure Set_Id (This : in out Creature;  To : Creature_Count) is
   begin
      This.Id := To;
   end Set_Id;

   --------
   -- Id --
   --------

   function Id (This : Creature) return Creature_Count is
   begin
      return This.Id;
   end Id;

   -------------------
   -- Current_Color --
   -------------------

   function Current_Color (This : Creature) return Colors is
   begin
      return This.Color;
   end Current_Color;

   -------------------
   -- Initial_Color --
   -------------------

   function Initial_Color (This : Creature) return Colors is
   begin
      return This.Starting_Color;
   end Initial_Color;

   -------------
   -- Display --
   -------------

   procedure Display (This : in out Creature) is
   begin
      Put (This.Count);
      Put_Line (Spelled (This.Same_Count));
   end Display;

   ---------------
   -- Total_Met --
   ---------------

   function Total_Met (This : Creature) return Natural is
   begin
      return This.Count;
   end Total_Met;

   ------------
   -- Thread --
   ------------

   task body Thread is
      use Chameneos.Meetings;
   begin
      Meet_Others (This.Rendezvous_Point.all, Player => This);
      This.Completion.Signal;
   end Thread;

end Chameneos.Creatures;

-------------------------------------------------------------------------------

with GNAT.IO;  use GNAT.IO;

package body Chameneos.Games is

   -----------
   -- Start --
   -----------

   procedure Start
     (This            : in out Game;
      Creature_Colors : Color_List_Ref;
      Num_Meetings    : Meeting_Count;
      Slot            : Natural)
   is
      Color_Index : Positive := Creature_Colors'First;
      --  We use a separate index, instead of the index used to iterate over
      --  This.Players, since the bounds need not be the same. The range of
      --  This.Players is 1 .. Num_Creatures, where that upper bound is set as a
      --  discriminant to the game when it is created. The actual value passed
      --  to this discriminant comes from the length of an array of colors,
      --  which is then passed to this procedure in Creature_Colors, so the
      --  count will be the same. There is no guarantee of that, of course, but
      --  in practice that will suffice.
   begin
      This.Rendezvous_Point := new Meetings.Place (Num_Meetings);
      for K in This.Players'Range loop
         This.Players (K) := new Creature (Creature_Colors (Color_Index));
         This.Players (K).Start
           (Location => This.Rendezvous_Point,
            Latch    => This.Latch'Unchecked_Access,
            Slot     => Slot);
         Color_Index := Color_Index + 1;
      end loop;
   end Start;

   ----------------------
   -- Await_Completion --
   ----------------------

   procedure Await_Completion (This : Game) is
   begin
      for K in This.Players'Range loop
         This.Players (K).Await_Completion;
      end loop;
   end Await_Completion;

   -------------
   -- Display --
   -------------

   procedure Display (This : Game) is
      Grand_Total : Natural := 0;
   begin
      for K in This.Players'Range loop
         Put( " " & Colors_Image (This.Players (K).Initial_Color).all);
      end loop;
      New_Line;

      for K in This.Players'Range loop
         This.Players (K).Display;
         Grand_Total := Grand_Total + This.Players (K).Total_Met;
      end loop;
      Put_Line (Spelled (Grand_Total));
      New_Line;
   end Display;

end Chameneos.Games;

-------------------------------------------------------------------------------

with Chameneos.Creatures;
with x86_Atomic_Swap_Utils;  use x86_Atomic_Swap_Utils;

package body Chameneos.Meetings is

   --------------
   -- Register --
   --------------

   procedure Register
     (This   : in out Place;
      Player : access Chameneos.Creatures.Creature)
   is
      Id : constant Creature_Count := This.Id_Generator;
   begin
      Player.Set_Id (Id);
      This.Registered_Players (Id) := Player;
      This.Id_Generator := This.Id_Generator + 1;
   end Register;


   --  the lower part of the shared variable State, used to represent those
   --  chameneos wating for a meeting in the mall
   Creature_Mask : constant := 2 ** Creature_Mask_Bits - 1;

   --  the additional meeting count value due to the creature mask
   Count_Offset : constant Unsigned_32 := Shift_Left (1, Creature_Mask_Bits);


   -----------------
   -- Meet_Others --
   -----------------

   procedure Meet_Others
     (This   : in out Place;
      Player : access Chameneos.Creatures.Creature)
   is
      Local_State       : Unsigned_32 := This.Shared_State;
      Waiting           : Unsigned_32;
      Target_State      : Unsigned_32;
      State_Before_Swap : Unsigned_32;
   begin
      loop
         --  get the Id of a creature waiting for a meeting, if any
         Waiting := Local_State and Creature_Mask;
         if Waiting /= No_Creature then
            --  at least one creature is in the mall, waiting for a rendezvous,
            --  so we set the target state to the current meeting count - 1 to
            --  reflect the meeting we're about to attempt
            Target_State := (Local_State and not Creature_Mask) - Count_Offset;
         elsif Local_State /= 0 then
            --  no creatures are waiting but there are meetings remaining so set
            --  the target state to reflect Player, who is willing to meet
            Target_State := Local_State or Player.Id;
         else  --  no creatures waiting and no further meetings to be held
            exit;
         end if;

         --  Attempt to update the shared game state. If the value of the shared
         --  state is that of the local copy when the swap is attempted, then
         --  the shared state will be updated, otherwise it is not changed.
         State_Before_Swap := Sync_Val_Compare_And_Swap
           (Destination => This.Shared_State'Access,
            Comparand   => Local_State,
            New_Value   => Target_State);

         if State_Before_Swap = Local_State then -- we successfully updated it
            if Waiting /= 0 then
               Player.Meet (This.Registered_Players (Waiting).all);
            else
               Player.Wait_Until_Met;
            end if;

            Local_State := Target_State;
         else  -- we did not update the shared state, so use the shared value
            Local_State := State_Before_Swap;
         end if;
      end loop;
   end Meet_Others;

end Chameneos.Meetings;

-------------------------------------------------------------------------------

package body Chameneos.Countdown is

   -----------
   -- Latch --
   -----------

   protected body Latch is

      ----------
      -- Wait --
      ----------

      entry Wait when Count = 0 is
      begin
         null;
      end Wait;

      ------------
      -- Signal --
      ------------

      procedure Signal is
      begin
         Count := Count - 1;
      end Signal;

   end Latch;

end Chameneos.Countdown;

-------------------------------------------------------------------------------

with System.Memory;
with Ada.Unchecked_Conversion;

package body Cache_Aligned_Storage_Pools is

   use System, System.Storage_Elements;

   --  we cannot use System.Address'Size as the modulus so we use the same thing
   --  that the compiler does (when declaring Address as a modular type in the
   --  full definition)
   type Unsigned_Address is mod System.Memory_Size;

   function As_Unsigned_Address is new Ada.Unchecked_Conversion
     (Source => Address,
      Target => Unsigned_Address);

   function As_Address is new Ada.Unchecked_Conversion
     (Target => Address,
      Source => Unsigned_Address);

   type Address_Pointer is access all Address;
   for Address_Pointer'Storage_Size use 0;

   function As_Address_Pointer is new Ada.Unchecked_Conversion
     (Source => Address,
      Target => Address_Pointer);

   --  size of an address in terms of storage units
   Size_Of_Address : constant Storage_Offset := Address'Size / System.Storage_Unit;

   Twice_Cache_Line_Size : constant := 2 * Cache_Line_Size;

   --------------
   -- Allocate --
   --------------

   procedure Allocate
     (Pool            : in out Cache_Aligned_Storage_Pool;
      Storage_Address : out System.Address;
      Requested_Size  : SSE.Storage_Count;
      Alignment       : SSE.Storage_Count)
   is
      pragma Unreferenced (Pool);
      pragma Unreferenced (Alignment);

      Actual  : Address;
      Aligned : Address;
      Header  : Address;
      Temp    : Unsigned_Address;
   begin
      Actual := Memory.Alloc (Memory.size_t (Requested_Size + Twice_Cache_Line_Size));
      --  The call to Alloc returns an address whose alignment is compatible
      --  with the worst case alignment requirement for the machine; thus the
      --  Alignment argument can be safely ignored.

      if Actual = Null_Address then
         raise Storage_Error;
      end if;

      --  compute a cache-aligned address within the block allocated
      Temp := As_Unsigned_Address (Actual + Cache_Line_Size) and not (Cache_Line_Size - 1);
      Aligned := As_Address (Temp);
      --  Put the address of the whole allocated block just before the address
      --  given to the application so we can deallocate the whole block later
      Header := Aligned - Size_of_Address;
      As_Address_Pointer (Header).all := Actual;
      Storage_Address := Aligned;
   end Allocate;

   ----------------
   -- Deallocate --
   ----------------

   procedure Deallocate
     (Pool            : in out Cache_Aligned_Storage_Pool;
      Storage_Address : System.Address;
      Requested_Size  : SSE.Storage_Count;
      Alignment       : SSE.Storage_Count)
   is
      pragma Unreferenced (Pool);
      pragma Unreferenced (Requested_Size);
      pragma Unreferenced (Alignment);

      Actual : Address;
      Header : Address;
   begin
      Header := Storage_Address - Size_of_Address;
      Actual := As_Address_Pointer (Header).all;
      Memory.Free (Actual);
   end Deallocate;

   ------------------
   -- Storage_Size --
   ------------------

   function Storage_Size
     (Pool  : Cache_Aligned_Storage_Pool)
      return  SSE.Storage_Count
   is
      pragma Warnings (Off, Pool);
   begin
      return SSE.Storage_Count'Last;
   end Storage_Size;

   ------------------
   -- Allocate_Any --
   ------------------

   procedure Allocate_Any
     (Pool            : in out Cache_Aligned_Storage_Pool'Class;
      Storage_Address : out System.Address;
      Requested_Size  : SSE.Storage_Count;
      Alignment       : SSE.Storage_Count)
   is
   begin
      Allocate (Pool, Storage_Address, Requested_Size, Alignment);
   end Allocate_Any;

   --------------------
   -- Deallocate_Any --
   --------------------

   procedure Deallocate_Any
     (Pool            : in out Cache_Aligned_Storage_Pool'Class;
      Storage_Address : System.Address;
      Requested_Size  : SSE.Storage_Count;
      Alignment       : SSE.Storage_Count)
   is
   begin
      Deallocate (Pool, Storage_Address, Requested_Size, Alignment);
   end Deallocate_Any;

end Cache_Aligned_Storage_Pools;

-------------------------------------------------------------------------------

with Interfaces.C;

package body Chameneos.Processors is

   Cores_Per_Slot : constant := 2;

   Affinities : array (0 .. Max_Slots) of aliased CPU_Set;
   --  we use the first slot (ie 0) for the global affinity mask, internally,
   --  hence there are Max_Slots-1 total slots available to the application
   --  threads, and a total of ((Max_Slots-1) * Cores_Per_Slot) cores supported

   Slot_Modulus : Natural;

   --------------
   -- Affinity --
   --------------

   function Affinity (Slot : Natural) return cpu_set_t is
   begin
      if Slot = 0 then
         return Affinities (Slot);
      else
         return Affinities ((Slot mod Slot_Modulus) + 1);
      end if;
   end Affinity;

   -----------------------
   -- sched_getaffinity --
   -----------------------

   function Sched_Getaffinity
     (Pid : Pid_T;  Cpusetsize : Unsigned_32;  Mask : access CPU_Set)
      return Interfaces.C.int;
   pragma Import (C, sched_getaffinity);


   subtype Bit_Number is Integer range bit_field'Range;

   --------------
   --  Set_Bit --
   --------------

   procedure Set_Bit (Bit : Bit_Number;  Within : in out CPU_Set) is
   begin
      Within.bits (Bit) := True;
   end Set_Bit;

   -------------------------------
   -- Define_Affinities_By_Slot --
   -------------------------------

   procedure Define_Affinities_By_Slot is
      Num_Bits_Set     : Natural := 0;
      Global_Mask      : CPU_Set renames Affinities (0);
      Result           : Int;
      Global_Mask_Size : constant Unsigned_32 := Global_Mask'Size / System.Storage_Unit;
      Next_Affinity    : Natural;
      use type Interfaces.C.int;
   begin
      Result := sched_getaffinity (getpid, Global_Mask_Size, Global_Mask'Access);
      if Result /= 0 then
         raise Program_Error with "Could not get affinity";
      end if;

      for B in 1 .. CPU_SETSIZE loop
         if Global_Mask.Bits (B) then
            Next_Affinity := (Num_Bits_Set / Cores_Per_Slot) + 1;
            if Next_Affinity not in Affinities'Range then
               --  there are more processors enabled than we support, but
               --  that is OK since we only want a few
               exit;
            end if;
            Set_Bit (B, Affinities (Next_Affinity));
            Num_Bits_Set := Num_Bits_Set + 1;
         end if;
      end loop;

      if Num_Bits_Set > 2 then
         Slot_Modulus := Num_Bits_Set / 2;
      else
         Slot_Modulus := 1;
      end if;
   end Define_Affinities_By_Slot;


begin
   for K in Affinities'Range loop
      Affinities (K).bits := (others => False);
   end loop;
   Define_Affinities_By_Slot;
end Chameneos.Processors;

-------------------------------------------------------------------------------

with System.Machine_Code;  use System.Machine_Code;

package body x86_Atomic_Swap_Utils is

   -------------------------------
   -- Sync_Val_Compare_And_Swap --
   -------------------------------

   function Sync_Val_Compare_And_Swap
     (Destination : access Unsigned_32;
      Comparand   : Unsigned_32;
      New_Value   : Unsigned_32)
      return Unsigned_32
   is
      Prior_Value : Unsigned_32;
      pragma Suppress (All_Checks);
   begin
      --  %eax := Comparand
      --  if %eax = Destination.all then
      --     Destination.all := New_Value
      --  else
      --     %eax := Destination.all
      --  end if
      Asm("lock cmpxchg %1, %2;",
        Inputs  => (Unsigned_32'Asm_Input ("r", New_Value),        -- %1
                    Unsigned_32'Asm_Input ("m", Destination.all),  -- %2
                    Unsigned_32'Asm_Input ("a", Comparand)),
        Outputs => (Unsigned_32'Asm_Output ("=a", Prior_Value)),   -- %0
        Clobber => "memory, cc",
        Volatile => True);
      --  return %eax
      return Prior_Value;
   end Sync_Val_Compare_And_Swap;

end x86_Atomic_Swap_Utils;

 make, command-line, and program output logs

Tue, 28 Apr 2015 21:43:38 GMT

MAKE:
/usr/bin/gnatchop -r -w chameneosredux.gnat-2.gnat
splitting chameneosredux.gnat-2.gnat into:
   chameneosredux.adb
   chameneos.ads
   chameneos-creatures.ads
   chameneos-games.ads
   chameneos-meetings.ads
   cache_aligned_storage_pools.ads
   chameneos-countdown.ads
   chameneos-processors.ads
   x86_atomic_swap_utils.ads
   chameneos.adb
   chameneos-creatures.adb
   chameneos-games.adb
   chameneos-meetings.adb
   chameneos-countdown.adb
   cache_aligned_storage_pools.adb
   chameneos-processors.adb
   x86_atomic_swap_utils.adb
/usr/bin/gnatmake -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp -f chameneosredux.adb -o chameneosredux.gnat-2.gnat_run 
gcc-4.9 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp chameneosredux.adb
chameneosredux.gnat-2.gnat:429:46: "CPU_Set" is not visible
chameneosredux.gnat-2.gnat:429:46: multiple use clauses cause hiding
chameneosredux.gnat-2.gnat:429:46: hidden declaration at s-tasinf.ads:79
chameneosredux.gnat-2.gnat:429:46: hidden declaration at s-osinte.ads:559
gnatmake: "chameneosredux.adb" compilation error
/home/dunham/benchmarksgame/nanobench/makefiles/u32.programs.Makefile:31: recipe for target 'chameneosredux.gnat-2.gnat_run' failed
make: [chameneosredux.gnat-2.gnat_run] Error 4 (ignored)
0.18s to complete and log all make actions

COMMAND LINE:
./chameneosredux.gnat-2.gnat_run 60000

MAKE ERROR 

Revised BSD license

  Home   Conclusions   License   Play