; 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	FALSE		;true, if high bits not significant
;
SORT:	SHLD	SSTADR
	PUSH	H
	XCHG
	SHLD	SRECLEN
	PUSH	H
	MOV	H,B
	MOV	L,C
	SHLD	SNUMRT
	SHLD	SNUMRW
;
; NOW DIVIDE # OF FIELDS BY 2
;
DIVIDE:	LHLD	SNUMRW	;GET VALUE
	ORA	A		;CLEAR CARRY
	MOV	A,H
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	SHLD	SNUMRW	;SAVE RESULT
	MOV	A,L		;IF SNUMRW<>0
	ORA	H		;  THEN
	JNZ	NOTDONE		;    NOT DONE
;
; ALL FIELDS SORTED
;
	POP	B		;CLEAN UP STACK
	POP	D
	RET
;
NOTDONE:XCHG
	LHLD	SNUMRT
	MOV	A,L
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	SHLD	SRECLEN
	LXI	H,1
	SHLD	SORTV1
	SHLD	SSTADR
	DCR	L
	POP	B
	PUSH	B
NDONE1:	DAD     D
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	NDONE1
	SHLD	SORTV2
	XCHG
	POP	B
	POP	H
	PUSH	H
	PUSH	B
NDONE2:	SHLD	SORTV4
	SHLD	SORTV3
	XCHG
	DAD	D
	XCHG
COMPRE:	POP	B
	PUSH	B
COMPR1:	LDAX	D
	IF	STRIPHI
	ANI	7FH
	PUSH	B
	PUSH	PSW
	MOV	A,M
	ANI	7FH
	MOV	B,A
	POP	PSW
	SUB	B
	POP	B
	ELSE
	SUB	M
	ENDIF
	JNZ	NOTEQU
	INX	H
	INX	D
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	COMPR1
	JMP	NOSWITCH
;
NOTEQU:
	IF	ASCEND
	JNC	NOSWITCH
	ELSE
	JC	NOSWITCH
	ENDIF
SWITCH:	PUSH	B
	MOV	B,M
	LDAX	D
	MOV	M,A
	MOV	A,B
	STAX	D
	INX	H
	INX	D
	POP	B
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	SWITCH
	LHLD	SNUMRW
	MOV	A,H
	CMA
	MOV	D,A
	MOV	A,L
	CMA
	MOV	E,A
	LHLD	SORTV1
	DAD	D
	JNC	NOSWITCH
	INX	H
	SHLD	SORTV1
	LHLD	SORTV3
	XCHG
	LHLD	SORTV2
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	SORTV3
	JMP	COMPRE
;
NOSWITCH:
	LHLD	SSTADR
	INX	H
	SHLD	SSTADR
	SHLD	SORTV1
	XCHG
	LHLD	SRECLEN
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	JC	DIVIDE
	LHLD	SORTV4
	POP	D
	PUSH	D
	DAD	D
	XCHG
	LHLD	SORTV2
	XCHG
	JMP	NDONE2
;.....
;
;
; UTILITY SUBTRACTION SUBROUTINE...
; HL=HL-DE
;
SUBDE:	MOV	A,L
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	RET
;
SRECLEN:DW	0
SSTADR:	DW	0
SORTV1:DW	0
SORTV2:DW	0
SORTV3:DW	0
SORTV4:DW	0
SNUMRT:DW	0
SNUMRW:DW	0