; SHELL-METZNER SORT
; Call with the following information:
;
; BC  =  Number of records to be sorted
; DE  =  Record length
; HL  =  Buffer address
;
; Comment out the following line if subroutine is
; to be yanked into a file instead of using RMAC/LINK
;
	PUBLIC SORT
;
TRUE	EQU	255
FALSE	EQU	0
;
ASCEND	EQU	TRUE		; Set FALSE for descending sort
STRIPHI EQU	TRUE		; True, if high bits not significant
;
SORT:	LD	(SSTADR),HL
	PUSH	HL
	EX	DE,HL
	LD	(SRECLEN),HL
	PUSH	HL
	LD	H,B
	LD	L,C
	LD	(SNUMRECT),HL
	LD	(SNUMRECW),HL
;
; NOW DIVIDE # OF FIELDS BY 2
;
DIVIDE:	LD	HL,(SNUMRECW)	; GET VALUE
	OR	A		; CLEAR CARRY
	LD	A,H
	RRA
	LD	H,A
	LD	A,L
	RRA
	LD	L,A
	LD	(SNUMRECW),HL	; SAVE RESULT
	LD	A,L		; IF SNUMRECW<>0
	OR	H		;  THEN
	JR	NZ,NOTDONE	;    NOT DONE
;
; ALL FIELDS SORTED
;
	POP	BC		; CLEAN UP STACK
	POP	DE
	RET
;
NOTDONE:EX	DE,HL
	LD	HL,(SNUMRECT)
	LD	A,L
	SUB	E
	LD	L,A
	LD	A,H
	SBC	A,D
	LD	H,A
	LD	(SRECLEN),HL
	LD	HL,1
	LD	(SSORTV1),HL
	LD	(SSTADR),HL
	DEC	L
	POP	BC
	PUSH	BC
NDONE1:	ADD	HL,DE
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,NDONE1
	LD	(SSORTV2),HL
	EX	DE,HL
	POP	BC
	POP	HL
	PUSH	HL
	PUSH	BC
NDONE2:	LD	(SSORTV4),HL
	LD	(SSORTV3),HL
	EX	DE,HL
	ADD	HL,DE
	EX	DE,HL
COMPARE:POP	BC
	PUSH	BC
COMPAR1:LD	A,(DE)
	 IF	STRIPHI
	AND	7FH
	PUSH	BC
	PUSH	AF
	LD	A,(HL)
	AND	7FH
	LD	B,A
	POP	AF
	SUB	B
	POP	BC
	 ELSE
	SUB	(HL)
	 ENDIF
	JR	NZ,NOTEQU
	INC	HL
	INC	DE
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,COMPAR1
	JR	NOSWITCH
;
NOTEQU:
	 IF	ASCEND
	JR	NC,NOSWITCH
	 ELSE
	JR	C,NOSWITCH
	 ENDIF
SWITCH:	PUSH	BC
	LD	B,(HL)
	LD	A,(DE)
	LD	(HL),A
	LD	A,B
	LD	(DE),A
	INC	HL
	INC	DE
	POP	BC
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,SWITCH
	LD	HL,(SNUMRECW)
	LD	A,H
	CPL
	LD	D,A
	LD	A,L
	CPL
	LD	E,A
	LD	HL,(SSORTV1)
	ADD	HL,DE
	JR	NC,NOSWITCH
	INC	HL
	LD	(SSORTV1),HL
	LD	HL,(SSORTV3)
	EX	DE,HL
	LD	HL,(SSORTV2)
	LD	A,E
	SUB	L
	LD	L,A
	LD	A,D
	SBC	A,H
	LD	H,A
	LD	(SSORTV3),HL
	JR	COMPARE
;
NOSWITCH:
	LD	HL,(SSTADR)
	INC	HL
	LD	(SSTADR),HL
	LD	(SSORTV1),HL
	EX	DE,HL
	LD	HL,(SRECLEN)
	LD	A,L
	SUB	E
	LD	A,H
	SBC	A,D
	JP	C,DIVIDE
	LD	HL,(SSORTV4)
	POP	DE
	PUSH	DE
	ADD	HL,DE
	EX	DE,HL
	LD	HL,(SSORTV2)
	EX	DE,HL
	JR	NDONE2
;.....
;
;
; UTILITY SUBTRACTION SUBROUTINE...
; HL=HL-DE
;
SUBDE:	LD	A,L
	SUB	E
	LD	L,A
	LD	A,H
	SBC	A,D
	LD	H,A
	RET

	DSEG
;
SRECLEN:
	DS	2
SSTADR:
	DS	2
SSORTV1:
	DS	2
SSORTV2:
	DS	2
SSORTV3:
	DS	2
SSORTV4:
	DS	2
SNUMRECT:
	DS	2
SNUMRECW:
	DS	2

	END