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