Batcher's Parallel Sort

This is an Ada implementation of Batcher's parallel sort from
Knuth.  The style is not nice since this was one of my earliest Ada
programs and it follows Knuth's algorithm description very closely.


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


-- This is a simple implementation of Batcher's parallel sort, from
-- Knuth Volume 3, 5.2.2
--
-- It would be interesting to know the results of running it on a
-- machine with multiple processors, or a single shared processor
-- where multiple tasks give you a larger share of machine resources
-- than one task.  The test example is too small to do any more than
-- demonstrate that it runs.
--
-- There are three parts: par_sort specification, body, and par_test
-- separated by -----------------------
--
--    Copyright Tom Moran, 1988, 2000, anyone may use for any purpose.
--
-----------------------

package PAR_SORT is

-- Batcher's parallel method
-- Knuth 5.2.2

-- call procedure sort(n) with number of elements to be sorted
--
-- User must supply leq(i,j) => true iff i-th item <= j-th item
-- and exchange(i,j) to exchange i-th and j-th items.
-- i, j will always be in range 1..n
--
-- NOTE: leq and exchange must be re-entrant as they will be
-- called by simultaneously active tasks.
-- For leq, and separately for exchange, these multiple calls
-- will have disjoint i,j parameter pairs.  For a particular
-- pair, leq may be called, and after it has returned, exchange
-- may be called with the same pair of parameters.

    generic
        with function LEQ(I, J : POSITIVE) return BOOLEAN;
        with procedure EXCHANGE(I, J : in POSITIVE);
        -- instead of positive, i,j are really in 1..n, but we don't
        -- yet know n

        procedure SORT(N : in POSITIVE);

end PAR_SORT;

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

package body PAR_SORT is

    procedure SORT(N : in POSITIVE) is
        type mod_int is mod 32768;
        subtype POSITIONS is mod_int range 1 .. mod_int(N);

        P, Q, R, D, TWO_TO_T_MINUS_ONE : mod_int; -- see Knuth 5.2.2
                                                  -- we follow his notation

        task type ORDER_TASK is
            entry GET_PAIR(I, J : in POSITIONS);
        end ORDER_TASK;
        for ORDER_TASK'Storage_Size use 4096;

        task body ORDER_TASK is
            LOWER, HIGHER : POSITIONS;
        begin
            accept GET_PAIR(I, J : in POSITIONS) do
                LOWER := I; HIGHER := J;
            end GET_PAIR;

            if LEQ(positive(HIGHER), positive(LOWER)) then
              EXCHANGE(positive(LOWER), positive(HIGHER));
            end if;
        end ORDER_TASK;

    begin
        if N < 2 then return; end if;

        -- M1    (following Knuth)
        TWO_TO_T_MINUS_ONE := 1;
        while TWO_TO_T_MINUS_ONE < mod_int(N / 2) loop
            TWO_TO_T_MINUS_ONE := TWO_TO_T_MINUS_ONE * 2;
        end loop;
        P := TWO_TO_T_MINUS_ONE;
        -- M2
        while P > 0 loop
            Q := TWO_TO_T_MINUS_ONE;
            R := 0;
            D := P;
            -- M3
            loop -- until q = p

                declare
                    type ORDERER is access ORDER_TASK;
                    ORDER_A_PAIR : ORDERER;
                begin
                    for I in 0 .. mod_int(N) - D - 1 loop
                        if (I and  P) = R then
                            ORDER_A_PAIR := new ORDER_TASK;
                            ORDER_A_PAIR.GET_PAIR(I + 1, I + D + 1);
                        end if;
                    end loop; -- on i
                end; -- won't leave this block till all tasks have
terminated

                -- M5
                exit when Q = P;
                D := Q - P; Q := Q / 2; R := P;
            end loop; -- on q
            -- M6
            P := P / 2;
        end loop; -- on p

    end SORT;

end PAR_SORT;

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

-- test Batcher's parallel sort routine using Knuth's example data

with PAR_SORT,
     Ada.TEXT_IO;
 use Ada.TEXT_IO;

procedure PAR_TEST is

    package INT_IO is new INTEGER_IO(INTEGER); use INT_IO;

    A : array (1 .. 16) of INTEGER :=
    (503,087,512,061,908,170,897,275,653,426,154,509,612,677,765,703);

    function LEQ(I, J : POSITIVE) return BOOLEAN is
    begin
        return (A(I) <= A(J));
    end LEQ;

    procedure EXCHANGE(I, J : in POSITIVE) is
        TEMP : INTEGER;
    begin
        TEMP := A(I); A(I) := A(J); A(J) := TEMP;
    end EXCHANGE;

    procedure TEST_SORT is new PAR_SORT.SORT(LEQ, EXCHANGE);

    procedure SHOW_A is
    begin
        for I in A'range loop
            PUT(A(I), WIDTH => 3);
            if I < A'LAST then PUT(","); end if;
        end loop;
        NEW_LINE;
    end SHOW_A;

begin

    SHOW_A;
    TEST_SORT(A'LENGTH);
    SHOW_A;

end PAR_TEST;