Source code in the freebasic programming language

' version 22-10-2016
' compile with: fbc -s console
' for boundary checks on array's compile with: fbc -s console -exx

' sort from lower bound to the higher bound
' array's can have subscript range from -2147483648 to +2147483647

Sub siftdown(hs() As Long, start As ULong, end_ As ULong)
    Dim As ULong root = start
    Dim As Long lb = LBound(hs)

    While root * 2 + 1 <= end_
        Dim As ULong child = root * 2 + 1
        If (child + 1 <= end_) AndAlso (hs(lb + child) < hs(lb + child + 1)) Then
            child = child + 1
        End If
        If hs(lb + root) < hs(lb + child) Then
            Swap hs(lb + root), hs(lb + child)
            root = child
        Else
            Return
        End If
    Wend
End Sub

Sub heapsort(hs() As Long)
    Dim As Long lb = LBound(hs)
    Dim As ULong count = UBound(hs) - lb + 1
    Dim As Long start = (count - 2) \ 2
    Dim As ULong end_ = count - 1

    While start >= 0
        siftdown(hs(), start, end_)
        start = start - 1
    Wend

    While end_ > 0
        Swap hs(lb + end_), hs(lb)
        end_ = end_ - 1
        siftdown(hs(), 0, end_)
    Wend
End Sub

' ------=< MAIN >=------

Dim As Long array(-7 To 7)
Dim As Long i, lb = LBound(array), ub = UBound(array)

Randomize Timer
For i = lb To ub : array(i) = i : Next
For i = lb To ub
    Swap array(i), array(Int(Rnd * (ub - lb + 1)) + lb)
Next

Print "Unsorted"
For i = lb To ub
    Print Using " ###"; array(i);
Next : Print : Print

heapsort(array())

Print "After heapsort"
For i = lb To ub
    Print Using " ###"; array(i);
Next : Print

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End