; Quick sort routine. I've tested it at 500 data points and it works nicely!
; original program I wrote in fortran on a PDP11 back in 1980. Recursion
; is normally not possible in fortran BUT if you pass functions by address
; instead of reference it is. Just make sure your system stack is o.k.
; I tested it against a bubble and the Shell-Metzner and it's much faster.
; email question to glp@sleepy.anest.ufl.edu
;
$mod51
$nolist
$nosymbols
$include(c:\cet\test\macros.inc)
$include(c:\cet\inc\mymon.inc)
$include(c:\cet\inc\controls.inc)
$list
codeseg		equ	tpa		; transient program area
dataseg		equ	codeseg + (8*1024)
arrayseg	equ	dataseg + 256
stacksize	equ	2048
stackseg	equ	8000h - stacksize
ascending	equ	-1		; sort low to high
decending	equ	1		; sort high to low
points		equ	128		; number of data points
	
Z	bit	21h.2			; zero flag
N	bit	21h.3			; negative flag
val	data	22h
rnsl	data	4dh			; random number seed
stkptr	data	4eh			; and 4fh

; push	integer to data stack
pushi	macro	arg1
	ldx	word1,arg1
	pushw	word1
	endm
	
; pop integer from data stack
popi	macro	arg1
	popw	word1
	lxd	arg1,word1
	endm

; sort array from left to right cell
sort	macro	left,right
	pushi	left
	pushi	right
	call	rtsort
	endm

; swap integer array cells indexed by arg1 and arg2
swapi	macro	arg1,arg2
	pushi	arg1
	pushi	arg2
	call	rtswap
	endm

; compare array cells indexed by arg1 and arg2
; Z set if zero, C set if less, N set if negative
;
qcmp	macro	arg1,arg2
	pushi	arg1
	pushi	arg2
	call	rtcompare
	endm
;================================	
	cseg at codeseg
start:	jmp	main
$include(c:\cet\test\runtime.asm)		; runtime code
$include(c:\cet\test\rtmath.asm)		; math support
$include(c:\cet\test\random.asm)		; random number generator
;================================	
rtsort:
	popi	right
	popi	left

; if (left .ge. right) return
	bge	left,right,qsdone

; swap(left,(left + right) / 2)
	iadd	left,right		; w2 = result
	mov	r0,#word2
	mov	r2,#2
	clr	c
	call	mbsvr			; /2
	lxd	temp,word2	
	swapi	left,temp		; partition

; last = left
	ldx	word1,left
	lxd	last,word1

; do i=left+1,right
	ldx	word1,left
	adi	word1,1
	lxd	i,word1
	lxi	sc,1
	for	i,%isle,right,sc

; if(compare(i,left) .eq. direction then
	  qcmp	i,left		; word1 = result
	  lxd	temp,word1
	  bne	temp,direction,l10

; last = last + 1
	  axi	last,1

; call swap(last,i)
	  swapi	last,i
; endif
l10:
; end do
	next

	swapi	left,last

; last -1
	ldx	word1,last
	sdi	word1,1
	lxd	temp,word1	; temp = last - 1

	pushi	left		; save due to recursion
	pushi	right
	pushi	last
	sort	left,temp	; recurse
	popi	last
	popi	right
	popi	left
; last + 1
	ldx	word1,last
	adi	word1,1
	lxd	temp,word1	; temp = last + 1

	sort	temp,right
qsdone:	ret
;================================	
rtswap:
	popi	sidx2		; local idx2
	popi	sidx1		; local idx1
	lda	word3,fr,sidx1
	lda	word4,fr,sidx2
	lad	fr,sidx1,word4
	lad	fr,sidx2,word3
	ret
;
;================================	
rtcompare:
	popi	cidx2		; local idx2
	popi	cidx1		; local idx1
	lda	word3,fr,cidx1	; data from cell 1
	lda	word4,fr,cidx2	; data from cell 2
	mov	r0,#word3
	mov	r1,#word4
	mov	r2,#2
	call	mbcmp		; compare 'em
; bgt
	jb	Z,$+9		; is equal
	jb	N,$+6		; is negative
	jmp	rtcl10
; blt
	jb	Z,$+8		; is equal
	jnc	$+5		; is greater
	jmp	rtcl20
; set compare flag
rtcl30:	ldi	word1,0		; equal
	sjmp	rtcdun
rtcl10:	ldi	word1,1		; greater
	sjmp	rtcdun
rtcl20:	ldi	word1,-1	; less
	sjmp	rtcdun
rtcdun:	ret
;	
;================================	
main:	mov	stkptr,#high stkbot	; initialize data stack
	mov	stkptr+1,#low stkbot

	lxi	direction,ascending	; set sort direction

	lxi	i,1
	lxi	j,points
	lxi	sc,1
	for	i,%isle,j,sc
	  call	random		; create some data
	  mov	w2l,a
	  mov	w2h,#0
	  lad	fr,i,word2	; load array fr index i with data in word2
	  mov	a,w2l
	  call	prtrad
	  mov	a,#' '
	  call	sndchr
	next
	call	crlf

	lxi	i,1
	lxi	j,points
	sort	i,j		; sort data
;
	call	crlf
	lxi	i,1
	lxi	j,points
	lxi	sc,1
	for	i,%isle,j,sc
	  lda	word2,fr,i
	  mov	a,w2l
	  call	prtrad		; show sorted data
	  mov	a,#' '
	  call	sndchr
	next
	call	crlf

	ret			; back to monitor
;================================	
	cseg at dataseg
	word	direction	; up or down sorting
	word	right		; array index right
	word	left		; array index left
	word	last
	word	temp
	word	retadr		; loop return address
	word	i
	word	j
	word	k
	word	sc
	word	sidx1		; swap local vars
	word	sidx2
	word	cidx1		; compare local vars
	word	cidx2
;================================	
	cseg at arrayseg
	warray	fr,points	; data to sort
;================================	
	dseg at stackseg
stktop:
	ds	stacksize
stkbot:
	end