Heapsort routine

This is a Heap-Sortroutine
Captured from a message from Dirk Terrell (see EMail Addresses) in a public Internet news group (see Internet - Newsgroups)

 
/* ------------------------------------------------------------------ */
/* function: heap sort routine                                        */
/*                                                                    */
/* call:     HeapSort                                                 */
/*                                                                    */
/* returns:  nothing                                                  */
/*                                                                    */
/* notes:    You must save the elements to sort in the stem "STEM."   */
/*           stem.0 must contain the number of elements in the stem.  */
/*                                                                    */
/* reference: Sedgewick, "Algorithms"                                 */
/*                                                                    */
Heapsort: PROCEDURE expose stem.

  M = stem.0
  N = M

  do k=M % 2 to 1 by -1
    call DownHeap k N
  end /* do */

  do while N>1
    t = stem.1
    stem.1 = stem.n
    stem.n = t
    n = n-1
    call DownHeap 1 N
  end /* do */
RETURN

/* subroutine of HeapSort                                             */
DownHeap: PROCEDURE expose stem.
  parse Arg k N

  v = stem.k

  do while k <= N%2
    j = k+k
    if j < n then
    do
      i = j+1
      if stem.j << stem.i then                               /* v2.80 */
        j=j+1
    end  /* do */

    if v >>= stem.j then                                     /* v2.80 */
      signal Label

    stem.k = stem.j
    k = j
  end /* do */

Label:
  stem.k = v
RETURN