1. with Ada.Exceptions; use Ada.Exceptions; -- you might need this in case somebody put a bug in your program 
  2. with Ada.Text_IO;    use Ada.Text_IO;    -- you might need this to tell what bug it was 
  3. with CPU_Counter;    use CPU_Counter; 
  4.  
  5. procedure Concurrent_Mergesort (Sort_Field : in out Element_Array) is 
  6.  
  7.    procedure Mergesort (F : in out Element_Array) is 
  8.  
  9.    begin 
  10.       if F'Length > 1 then 
  11.          declare 
  12.             Middle : constant Index := Index'Val (Index'Pos (F'First) + F'Length / 2); 
  13.  
  14.             subtype Low_Range  is Index range F'First .. Index'Pred (Middle); 
  15.             subtype High_Range is Index range Middle  .. F'Last; 
  16.  
  17.             F_Low  : aliased Element_Array := F (Low_Range); 
  18.             F_High : aliased Element_Array := F (High_Range); 
  19.  
  20.             Gained_Agent : Boolean := False; 
  21.  
  22.          begin 
  23.             if CPUs_Potentially_Available then 
  24.                CPU_Count.Try_Check_One_Out (Gained_Agent); 
  25.             end if; 
  26.  
  27.             if Gained_Agent then 
  28.  
  29.                null; --> Replace this with concurrent operations 
  30.  
  31.             else 
  32.                Mergesort (F_Low); 
  33.                Mergesort (F_High); 
  34.             end if; 
  35.  
  36.             declare 
  37.                Low          : Low_Range  := Low_Range'First; 
  38.                High         : High_Range := High_Range'First; 
  39.                Low_Element  : Element    := F_Low  (Low); 
  40.                High_Element : Element    := F_High (High); 
  41.  
  42.             begin 
  43.                Merge : for i in F'Range loop 
  44.  
  45.                   if Low_Element < High_Element then 
  46.                      F (i) := Low_Element; 
  47.                      if Low = F_Low'Last then 
  48.                         F (Index'Succ (i) .. F'Last) := F_High (High .. F_High'Last); 
  49.                         exit Merge; 
  50.                      else 
  51.                         Low  := Index'Succ (Low); Low_Element  := F_Low (Low); 
  52.                      end if; 
  53.                   else 
  54.                      F (i) := High_Element; 
  55.                      if High = F_High'Last then 
  56.                         F (Index'Succ (i) .. F'Last) := F_Low (Low .. F_Low'Last); 
  57.                         exit Merge; 
  58.                      else 
  59.                         High := Index'Succ (High); High_Element := F_High (High); 
  60.                      end if; 
  61.                   end if; 
  62.                end loop Merge; 
  63.             end; 
  64.          end; 
  65.       end if; 
  66.    end Mergesort; 
  67.  
  68. begin 
  69.    Mergesort (Sort_Field); 
  70. end Concurrent_Mergesort;