Program Algorithm;

{ Straight two-way merge sort (internal).
  Described on page 164 of "The Art of Computer Programming"
  volume 3 / "Sorting and Searching" by Donald E. Knuth. }

const
  LIMIT = 256;

var
{ Restriction: LIMIT must be a power of 2
  and a scratch array of equal size is needed }
  rij, klad : array[1..LIMIT] of word;
  n : word;

procedure Sorteer;

{ Sort by merging equal sub-arrays }
{ -------------------------------- }

var
  keer, keren : byte;
  m, half, tussen, midden, delen, deel, onder : word;

function log2(w : word) : byte;

{ Number of bits in word }

var
  p : word;
  k : byte;

begin
  k := 0;
  p := w;
  while p > 0 do
  begin
    p := p shr 1;
    if p = 0 then Break;
    k := k + 1;
  end;
  log2 := k;
end;

procedure mergen;

{ Merge two halves into one }

var
  k1, k2, L : word;
begin
  k1 := 1;
  k2 := half + 1;
  for L := 1 to tussen do
  begin
    if klad[k1] <= klad[k2] then
    begin
      rij[L+onder] := klad[k1];
      klad[k1] := $FFFF;
      if k1 < midden then k1 := k1+1;
    end else begin
      rij[L+onder] := klad[k2];
      klad[k2] := $FFFF;
      if k2 < half+midden then k2 := k2+1;
    end;
  end;
end;

begin
  half := LIMIT shr 1;
  tussen := 1;
  delen := LIMIT;
  keren := log2(LIMIT);
  for keer := 1 to keren do
  begin
    midden := tussen;
    tussen := tussen shl 1;
    delen := delen shr 1;
    for deel := 1 to delen do
    begin
      onder := (deel-1)*tussen;
      for m := 1 to midden do
      begin
        klad[m] := rij[m+onder];
        klad[m+half] := rij[m+onder+midden];
      end;
      mergen;
    end;
  { Want to see how it works: }
  { for m := 1 to LIMIT do
      Write(rij[m],' ');
    Writeln; }
  end;
end;

begin
  for n := 1 to LIMIT-5 do
    rij[n] := Random(4*LIMIT)+1;
{ Adjust array with sentinel values: }
  for n := LIMIT-5+1 to LIMIT do
    rij[n] := $FFFF;
  Sorteer;
  for n := 1 to LIMIT do
    Write(rij[n],' ');
  Writeln;
end.