qsA.pr

(Parallel Quicksort using APERITIF)

{ PROGRAM: Parallel Quicksort
  Sorts in parallel an array of integers.
}
program quick_sort;
const	KILO = 1024;
      MEGA = KILO * KILO;
		SIZE = 3 * MEGA;			{ Size of the array }
type vectors = array[1..SIZE] of integer;
var  v: vectors;					{ Global vector to sort }

function random: integer; external;
procedure srandom(seed: integer); external;

{****************************************************************************}
{ Initializes the array randomly }
procedure generate(var v: vectors; size, seed: integer);
var i: integer;
begin
call srandom(seed);
for i := 1 to size do
	v[i] := random;
end;
{****************************************************************************}
{ Tests if the array is sorted }
procedure test(var v: vectors; size: integer);
var i: integer;
    ok: boolean;
begin
ok := true;
for i := 1 to size-1 do
  if v[i] > v[i+1] then
    ok := false;
  fi;
if ok then
  writeln('Array Sorted. Size: ', size);
else
  writeln('Array NOT Sorted. Size: ', size);
fi
end;
{****************************************************************************}
{ Partition the array in two segments: one containign elements lesser than
  the pivot and other with greater than the pivot. }
procedure partition(var v: array[dynamic first..last] of integer;
                    first, last: integer; result i, j: integer);
var pivot, temp: integer;
begin
i := first;
j := last;
pivot := v[(first + last) div 2];
repeat
  while (v[i] < pivot) do
    i := i + 1;
  while (v[j] > pivot) do
    j := j - 1;
  if (i <= j) then
    temp := v [i];
    v [i] := v [j];
    v [j] := temp;
    i := i + 1;
    j := j - 1;
    fi 
until (i > j);
end;
{****************************************************************************}
{ Parallel Quicksort }
procedure par_quicksort(var v: array[dynamic first..last] of integer; first, last: integer);
var i, j: integer;

begin
if child_available then
  if last > first then
    call partition(v[first..last], first, last, i, j);
    parbegin
      call par_quicksort(v[first..j], first, j);
      call par_quicksort(v[i..last], i, last);
    parend
  fi
else
  call seq_quicksort(v[first..last], first, last);
fi
end;
{****************************************************************************}
{ Sequential Hoare's Quicksort }
procedure seq_quicksort(var v: array[dynamic first..last] of integer; 
                        first, last: integer);
var i, j: integer;

begin
call partition(v[first..last], first, last, i, j);
if (first < j) then
  call seq_quicksort(v[first..j], first, j);
fi;
if (i < last) then
  call seq_quicksort(v[i..last], i, last);
fi;
end;
{****************************************************************************}
begin
call generate(v, SIZE, 0);
call seq_quicksort(v[1..SIZE], 1, SIZE);
call test(v, SIZE);

call generate(v, SIZE, 0);
call par_quicksort(v[1..SIZE], 1, SIZE);
call test(v, SIZE);
end.

This implementation was contributed by Francesco de Sande in June 1998.