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;

Contributed by: Tom Moran

Contributed on: May 31, 2000

License: Public Domain

Back