Program Algorithm;

{ Radix-exchange sort.
  Algorithm R on page 125 of "The Art of Computer Programming"
  volume 3 / "Sorting and Searching" by Donald E. Knuth.
  Using recursion, of course, instead of an additional stack. }

const
  N = 25;
  bits : byte = 0;

var
  rij : array[1..N] of word;
  m : word;

procedure bepaal_bits;

var
  rmax : word;
  k : word;
  b : byte;

begin
  rmax := rij[1];
  for k := 2 to N do
  begin
    if rij[k] > rmax then rmax := rij[k];
  end;
  if rmax = 0 then Exit;

  for b := 1 to 16 do
  begin
    bits := b;
    rmax := rmax shr 1;
    if rmax = 0 then Break;
  end;
end;

procedure Bitsort(l, r : word; b : byte);

var
  i, j : word;
  c : word;

function Bekijk(getal : word ; bit : byte) : byte;
begin
  Bekijk := (getal shr (bits-bit)) and 1;
end;

begin
  if l = r then Exit;
  if b > bits then Exit;

  i := l;
  j := r;

  repeat

    while (Bekijk(rij[i],b) = 0) and (i <= r) do
        i := i + 1;
    if i > r then
    begin
      Bitsort(l,r,b+1);
      Exit;
    end;

    while (Bekijk(rij[j],b) = 1) and (j >= l) do
        j := j - 1;
    if j < l then
    begin
      Bitsort(l,r,b+1);
      Exit;
    end;

    if i >= j then Break;
    c := rij[j];
    rij[j] := rij[i];
    rij[i] := c;

  until false;

  Bitsort(l,j,b+1);
  Bitsort(i,r,b+1);

end;

{ *********************** }

begin
  m := Random(3*N)+1;
  for m := 1 to N do
  begin
    rij[m] := Random(3*N)+1;
  end;

  for m := 1 to N do
    Write(rij[m],' ');
  Writeln;

  Bepaal_bits;

  Bitsort(1,N,1);

  for m := 1 to N do
    Write(rij[m],' ');
  Writeln;
end.