********************************************************************
*	HEAP SORT v1.0 by Tamir Demri
*
*	stk:	1: array  ->  1: sorted array
*	algorithm: convert the array to a heap. then every time get
*		the smallest and fix the heap. the heap follows this
*		definition : the 2 sons of A[i] are A[2i] (left)
*		and A[2i+1] (right). root is A[1].
*	exit:	ON quits leaving the array partialy sorted.
*	uses:	A,B,C,D,R2,R3,R4,P,D0,D1
*	stack levels:	4

ASSEMBLE
=TST	EQU	#2BD32
RPL
::
 CK1NoBlame
 CK&DISPATCH1
 FOUR
* ::
*  TOTEMPOB	(  \ uncomment for NEWOBing )
  CODE
	GOSBVL	=SAVPTR
	A=DAT1	A
	D1=A
	D1=D1+	5
	C=DAT1	A	length
	A=A+C	A	end-5
	A=A-CON A,11	end array-16 = last elem
	R4=A		last elem
	D1=D1+	10
	C=DAT1	A	dims
	C=C-CON	A,2
	GOC	1dim
	D1=D1+	5
1dim	D1=D1-	6	D1->body-16
	CD1EX
	R3=C
	C=A-C	A	n*16
	CSR	A	n
	R2=C
	CSRB.F	A	n/2
	D=C	A
	C=C-1	A	
	GOC	gptr	=> n=0,1 => nothing to sort

* convert the array to heap
make_heap
	C=D	A
	B=C	A
	GOSUB   sift_down	sift down A[B]
	D=D-1	A
	?D#0	A
	GOYES	make_heap

* (get smallest and do sift down)*(n-1)
	C=R2		n
	D=C	A
	D=D-CON	A,2	n-1 loops
	GONC	swp_min	(always) first time no need to sift down
nxt_el	GOSUB	sift_down
swp_min	C=0	A
	C=C+1	A
	B=C	A	B=1
	CSL	A	C=16	
	A=R3		base-16
	A=A+C	A	base
	D1=A
	A=R4		last elem
	D0=A
	A=A-C	A	end=end-16
	R4=A		
	GOSUB   swap
	D=D-1	A
	GONC	nxt_el

************************************************************
* here we have the array sorted but backwards so reverse it.
* go from both sides and swap the elements.

reverse	A=R3		first elem-16
	D1=A
	C=R2		n
	D=C	A	loop counter
	CSL	A
	A=A+C	A
	D0=A		last elem
nxt_swp	D=D-CON	A,2
	GOC	gptr
	D1=D1+	16	next
	GOSUB	swap
	D0=D0-	16	prev
	GONC	nxt_swp	(always)

drp_qt	C=RSTK

gptr	P=	0
	GOVLNG	=GETPTRLOOP

*****************************
* swaps dat0.w with dat1.w
swap	A=DAT0  W
	C=DAT1  W
	DAT1=A  W
	DAT0=C  W
	RTN

************************************************************* 
* first check ATTNFLG. 
* while a father is bigger than one of his sons - swap.
* start with A[i] until no swap needed.
* input : B=i , R4=last elem , R3=base-16 (->elem 0)

sift_down
* quit if ATTNFLG!=0 
	D1=(5)	(=addrATTNFLG)+2
	C=DAT1	A
	D1=C	A	ATTNFLG address
	C=DAT1	A
	C=C-1	A	
	GONC	drp_qt	(attn!=0)

do_sift	BSL	A	i*16
	A=R3    	base-16
	A=A+B	A	elem i address
deeper	D1=A
	A=A+B	A	elem 2i address
	D0=A
	B=B+B	A
	C=R4		last
	?A<C	A
	GOYES	normal
	?A=C	A	only left son
	GOYES	chk_fa	
	RTN		no sons 
normal	C=DAT0	W
	D0=D0+	16	elem 2i+1
	A=DAT0	W
	GOSUB	compare
	GONC	2iS
	B=B+1	A
	B=B+CON	A,15	B=(2i+1)*16
	GONC	chk_fa
2iS	D0=D0-	16
chk_fa	C=DAT0	W	smallest son
	A=DAT1	W	father
	GOSUB	compare
	RTNC		father is smallest
	GOSUB   swap	swap father with son
	AD0EX
	GOTO	deeper	

*********************************
* compares 2 reals: X=A, Y=C.
* unsupported but still works
	
compare	SETDEC
	GOSBVL	=TST	CS if X% <= Y%
	SETHEX
	RTN

  ENDCODE
* ;
;