; mails2/asm - kjw/bqsd - version 2.00 - 01/83
;
; revised 02/23/83 - kjw
;
	SUBTTL	'<mails2/asm - quicksort module>'
;
	PAGE
;
QUICK	LD	A,(SRTTBL+1)	;get length of sort field
	LD	(QLEN3),A	;pass length
	ADD	A,3		;add record # length
	LD	(QLEN1),A	;pass length
	LD	(QLEN2),A
	LD	(QLEN4),A
	PUSH	HL		;save mem start
	LD	HL,MSG33	;extra message
	CALL	DISPLAY		;display it
	POP	HL		;restore start
	LD	A,I		;are interrupts on?
	PUSH	AF		;save on stack
	DI			;disable for sort!
;
QUICK0	LD	(BASE),HL	;save base address
	LD	D,H		;pass HL => DE
	LD	E,L
	PUSH	BC		;save count
	JR	QUICK2		;continue
;
QUICK1	CALL	QCOMP		;quick compare
	JR	NC,QUICK2	;go if not less
	LD	(BASE),DE	;save new base
;
QUICK2	PUSH	HL		;save mem address
	LD	HL,0		;HL = length
QLEN1	EQU	$-2
	ADD	HL,DE		;HL => next entry
	EX	DE,HL		;DE => next entry
	POP	HL		;restore HL
	DEC	BC		;less count
	LD	A,B		;any more?
	OR	C		;BC = 0000H?
	JR	NZ,QUICK1	;finish this pass
;
	LD	BC,(BASE)	;get base address
	PUSH	HL		;save address
	OR	A		;clear carry flag
	SBC	HL,BC		;base = HL?
	POP	HL		;restore
	CALL	NZ,QSWAP	;swap data if not same
	LD	BC,0		;get data length
QLEN2	EQU	$-2
	ADD	HL,BC		;HL => next record
	POP	BC		;restore count
	DEC	BC		;less this pass
	LD	A,B		;any more?
	OR	C
	JR	NZ,QUICK0	;go next pass if more
;
	POP	AF		;restore previous interup
	RET	PO		;interrupts were off!
	EI			;can enable interrupts
	RET			;done!
;
;	quick compare routine
;
QCOMP	PUSH	DE		;pass mem address
	EXX			;swap registers
	POP	DE		;DE => address
	LD	HL,(BASE)	;get base address
	LD	B,0		;get index length
QLEN3	EQU	$-1
QCOMPLP	LD	A,(DE)		;get first byte
	CP	(HL)		;match?
	JR	NZ,QCOMPR	;go if not
	INC	DE		;bump source
	INC	HL		;bump base
	DJNZ	QCOMPLP		;go for length
QCOMPR	EXX			;swap back
	RET			;done
;
QSWAP	PUSH	BC		;save all
	PUSH	DE
	PUSH	HL
	LD	DE,(BASE)	;get base pointer
	LD	B,0		;get index length
QLEN4	EQU	$-1
QSWAP1	LD	C,(HL)		;get a byte
	LD	A,(DE)		;get second
	LD	(HL),A		;put in first
	LD	A,C		;get first
	LD	(DE),A		;put in second
	INC	DE		;bump pointers
	INC	HL
	DJNZ	QSWAP1		;go for length
	POP	HL		;unstack
	POP	DE
	POP	BC
	RET
;
;	sort memory buffer
;
SORTMEM	LD	BC,(RECMEM)	;get # records in memory
	LD	A,B		;anything?
	OR	C
	RET	Z		;nope, done!
	LD	HL,BUFFER	;start memory buffer
	BIT	0,(IY+0)	;quick-sort?
	JP	NZ,QUICK	;yes, go!
	PUSH	IX		;save it
;
SORT0	LD	(BASE),HL	;save memory base
	LD	D,H		;pass to DE
	LD	E,L
	PUSH	BC		;save loop counter
	JR	SORT2		;continue
;
SORT1	CALL	COMPARE		;compare records
	JR	NC,SORT2	;go if not less
	LD	(BASE),DE	;save lowest record
;
SORT2	PUSH	HL		;save memory pointer
	LD	L,(IY+30)	;get index offset
	LD	H,0		;HL = offset
	ADD	HL,DE		;HL => next entry
	EX	DE,HL		;DE => next entry
	POP	HL		;restore pointer
	DEC	BC		;less this record
	LD	A,B		;any more?
	OR	C		;BC = 0000?
	JR	NZ,SORT1	;go if more
;
	LD	BC,$		;get base address
BASE	EQU	$-2
	PUSH	HL		;save memory
	OR	A		;clear carry
	SBC	HL,BC		;at lowest now?
	POP	HL		;restore pointer
	JR	Z,SORT3		;go if match
	CALL	SWAP		;swap records
;
SORT3	LD	C,(IY+30)	;get record offset
	LD	B,0		;BC = offset
	ADD	HL,BC		;HL => next base
	POP	BC		;get loop counter
	DEC	BC		;less this pass
	LD	A,C		;get pass #
	AND	0FH		;change #
	JR	NZ,SORT3G	;go if not time!
;
	LD	A,0		;get flicker flag
FFLAG	EQU	$-1
	XOR	1		;reverse bit 0
	LD	(FFLAG),A	;re-save it
	PUSH	HL		;save
	LD	HL,MSGS3X	;'*'
	JR	NZ,$+5		;go if yes
	LD	HL,MSGS3Y	;'#'
	CALL	DISPLAY		;display 'flicker'
	POP	HL		;restore
;
SORT3G	LD	A,B		;any left
	OR	C		;BC = 0000?
	JR	NZ,SORT0	;go if more
;
	POP	IX		;unstack IX
	XOR	A		;return Z
	RET			;sort complete
;
;	swap index records
;
SWAP	PUSH	HL		;save pointers
	PUSH	DE
	PUSH	BC
;
	LD	DE,(BASE)	;get lowest pointer
	LD	B,(IY+30)	;get entry length
;
SWAPLP	LD	C,(HL)		;get entry
	LD	A,(DE)		;get other
	LD	(HL),A		;to first
	LD	A,C		;get first
	LD	(DE),A		;to second
	INC	HL		;bump source
	INC	DE		;bump dest
	DJNZ	SWAPLP		;go for entry length
;
	POP	BC		;unstack
	POP	DE
	POP	HL
	RET			;done
;
;##
;
MSGS1	DEFB	SETCUR
	DEFB	12,00
	DEFB	EOF
	DEFB	CR
	DEFB	CR
	DEFM	'Sort Complete - '
MSGS1A	DEFM	'xxxxxxxx Records Deleted, (KEY):'
	DEFB	ETX
;
MSGS2	DEFB	SETCUR
	DEFB	12,00
	DEFB	EOF
	DEFM	'Sorting Drive '
MSGS2A	DEFM	'x'
	DEFB	ETX
;
MSGS3	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	'* Sorting *'
	DEFB	ETX
;
MSG33	DEFM	' Do Not Disturb *'
	DEFB	ETX
;
MSGS3X	DEFB	SETCUR
	DEFB	14,00
	DEFM	'*'
	DEFB	SETCUR
	DEFB	14,10
	DEFM	'*'
	DEFB	ETX
;
MSGS3Y	DEFB	SETCUR
	DEFB	14,00
	DEFM	'#'
	DEFB	SETCUR
	DEFB	14,10
	DEFM	'#'
	DEFB	ETX
;
MSGS4	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	'* Writing Index *'
	DEFB	ETX
;
MSGS5	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	'Done, '
MSGS5A	DEFM	'xxxxxxxx Total Records Deleted, (KEY):'
	DEFB	ETX
;
MSGS6	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	'* Loading *'
	DEFB	ETX
;
MSGS7	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	'* Saving Sorted Temporary File *'
	DEFB	ETX
;
MSGS8	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	'* Merging Sorted Temporary Files *'
	DEFB	ETX
;
MSGS	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	'Error - '
	DEFB	ETX
;
MSGS0	DEFM	'(KEY) to continue:'
	DEFB	ETX
;
FILET	DEFM	'PMAIL'
FILETA	DEFM	'xxx/SRT'
	DEFB	ETX
FILETB	DEFB	'$'
	DEFB	ETX
;
PGM1	DEFM	'PMAILD/CMD'
	DEFB	SYSDRV
	DEFB	SYSDRVN
	DEFB	ETX
;
PGM2	DEFM	'PMAILM/CMD'
	DEFB	SYSDRV
	DEFB	SYSDRVN
	DEFB	ETX
;
MSG99	DEFM	'RUN PMAIL/CMD ONLY!'
MSG99L	EQU	$-MSG99
;
TABLE1	DEFB	000,15	;last
	DEFB	015,10	;first
	DEFB	025,20	;company
	DEFB	045,20	;addr 1
	DEFB	065,10	;addr 2
	DEFB	075,15	;city
	DEFB	090,08	;state
	DEFB	098,10	;zip
	DEFB	108,05	;data 1
	DEFB	113,12	;data 2
;
SRTTBL0	DEFB	-1,-1		;primary/secondary keys
SRTTBL	DEFB	-1,-1		;0
	DEFB	-1,-1		;1
	DEFB	-1,-1		;2
	DEFB	-1,-1		;3
	DEFB	-1,-1		;4
	DEFB	-1,-1		;5
	DEFB	-1,-1		;6
	DEFB	-1,-1		;7
	DEFB	-1,-1		;8
	DEFB	-1,-1		;9
	DEFB	-1,-1		;terminator
;
;	3 bytes of 00 for rewinds
;
REWIND	DEFB	00,00,00
;
;	open param lists for mod II
;
	IF	MOD2
OLIST	DEFW	0
	DEFW	0
	DEFW	0
	DEFB	'W'
	DEFB	0
	DEFB	'E'
	DEFB	0
	DEFB	00
;
OLISTI	DEFW	0
	DEFW	0
	DEFW	0
	DEFB	'W'
	DEFB	0
	DEFB	'E'
	DEFB	2
	DEFB	00
	ENDIF
;
