```// IfsHeapSort.bcpl
// Copyright Xerox Corporation 1979

// Last modified June 6, 1979  8:09 PM by Taft

external
[
// outgoing procedures
HeapSort
]

//----------------------------------------------------------------------------
let HeapSort(array, length, Compare) be
//----------------------------------------------------------------------------
// Knuth vol. 3 section 5.2.3 algorithm H.
// array!0 to array!(length-1) is an array of keys.
// Compare(key1, key2) returns -1 if key1<key2, 0 if =, 1 if >.
// Returns with array sorted in increasing order of keys.
[
if length le 1 return
let l, r = length rshift 1, length-1
[
let key = nil
test l gr 0
ifso
[ l = l-1; key = array!l ]
ifnot
[
key = array!r; array!r = array!0
r = r-1
if r eq 0 then
[ array!0 = key; break ]
]
let j = l
let i = nil
[
i = j
j = j lshift 1 +1
if j gr r break
if j ls r then if Compare(array!j, array!(j+1)) ls 0 then j = j+1
if Compare(key, array!j) ge 0 break
array!i = array!j
] repeat
array!i = key
] repeat
]
```