;
; SYSLIB Module Name:  SSORT
; Author:  Richard Conn
; SYSLIB Version Number:  2.5
; Module Version Number:  1.1
; Module Entry Points:
;	SSBINI		SORT
; Module External References:
;	MOVEB		PRINT
;
;*
;*  EXTERNALS
;*
	EXT	MOVEB
	EXT	PRINT

;*
;*  BASIC EQUATES
;*
CPM	EQU	0	; CP/M WARM BOOT
BIOS	EQU	CPM+1	; BIOS BASE ADDRESS
BDOS	EQU	CPM+5	; BDOS ENTRY POINT
ESIZE	EQU	16	; NUMBER OF BYTES/ENTRY IN MEMORY BUFFER
BUFF	EQU	CPM+80H	; DEFAULT DMA BUFFER

;*
;*  SSBINI -- Initialize SSB
;*	This routine sets the value of FIRSTP and ORDER for the SORT
;* routine.  On Entry, HL pts to first available byte after user's
;* program (beginning of buffer area) and DE pts to an SSB.  On exit,
;* HL pts to first available byte for the user's in-memory data file
;* (same address as FIRSTP).  If the TPA is overflowed by the ORDER
;* table that would be generated by SORT, then the Z flag is returned set
;* (Z); if no error, NZ is returned.
;*	If the user has already loaded his data and just wants to
;* allocate an ORDER table, then he should have HL before calling SSBINI,
;* restore HL upon return from SSBINI, and then store HL into his FIRSTP
;* entry before calling SORT.
;*
SSBINI::
	PUSH	D	; SAVE REGS
	PUSH	B
	PUSH	H	; SAVE NEXT AVAILABLE BYTE ADDRESS
	XCHG		; MAKE HL PT TO USER'S SSB
	SHLD	USRSSB	; SAVE PTR TO USER'S SSB
	LXI	D,SSB	; COPY INTO MY SSB
	MVI	B,12	; 12 BYTES
	CALL	MOVEB
	POP	H	; GET NEXT AVAILABLE BYTE ADDRESS
	SHLD	ORDER	; SET PTR TO IT
	LHLD	RECNT	; GET NUMBER OF RECORDS
	MOV	A,L	; DOUBLE IT WITH ERROR CHECKING
	ADD	L
	MOV	L,A
	MOV	A,H
	ADC	H
	MOV	H,A
	JC	SSBOVFL	; OVERFLOW IF CARRY
	XCHG		; SIZE OF ORDER TABLE IN DE
	LHLD	ORDER	; BASE ADDRESS OF ORDER TABLE IN HL
	MOV	A,L	; ADD HL TO DE WITH ERROR CHECKING
	ADD	E
	MOV	L,A
	MOV	A,H
	ADC	D
	MOV	H,A	; HL IS NOW ADDRESS OF BYTE AFTER ORDER TABLE
	JC	SSBOVFL	; OVERFLOW IF CARRY
	SHLD	FIRSTP	; SET PTR TO NEXT AVAILABLE BYTE
	LHLD	USRSSB	; PT TO USER'S SSB
	XCHG		; ... IN DE
	LXI	H,SSB	; PT TO USER'S NEW SSB
	MVI	B,12	; COPY IT BACK
	CALL	MOVEB
	POP	B	; RESTORE REGS
	POP	D
	LHLD	FIRSTP	; PT TO NEXT AVAILABLE MEMORY ADDRESS
	MVI	A,0FFH	; SET NO ERROR CODE
	ORA	A
	RET
SSBOVFL:
	POP	B	; RESTORE REGS
	POP	D
	LHLD	ORDER	; RESTORE PTR TO USER'S BUFFER
	XRA	A	; ERROR CODE
	RET
USRSSB:
	DS	2	; BUFFER FOR ADDRESS OF USER'S SSB

;*
;*  SORT -- Sort memory-resident file of fixed-length records in an order
;*	specified by the user;  On entry, DE pts to a SORT Specification
;*	Block (SSB) which contains the following information:
;*
;*		Bytes 0&1:  Starting Address of File (1st byte of 1st record)
;*		Bytes 2&3:  Number of Records in the File
;*		Bytes 4&5:  Size of Each Record (in Bytes)
;*		Bytes 6&7:  Address of a Compare Routine Provided by the User
;*				This routine compares two records, one pted
;*				to by HL and the other pted to by DE; if the
;*				record pted to by DE is less in sorting order
;*				than that pted to by HL, this routine returns
;*				with Carry Set (C); if the records are equal
;*				in sorting order, this routine returns with
;*				Zero Set (Z); no registers asside from the PSW
;*				are to be affected by this routine
;*		Bytes 8&9:  Address of ORDER Buffer (RECNT*2 in size)
;*		Byte 10:  Flag; 0 means to use pointers, 0FFH means to not
;*				use pointers
;*		Byte 11:  Unused
;*
;*	SORT does not have any net affect on any registers
;*

;
;  SORT SPECIFICATION BLOCK (SSB) FOR USE BY SORT ROUTINE
;
SSB:
FIRSTP:
	DS	2	; POINTER TO FIRST RECORD IN FILE
RECNT:
	DS	2	; NUMBER OF RECORDS IN FILE
RECSIZ:
	DS	2	; SIZE OF EACH RECORD
CMPADR:
	DS	2	; ADDRESS OF COMPARE ROUTINE
ORDER:
	DS	2	; ADDRESS OF ORDER TABLE
SFLAG:
	DS	1	; USE POINTERS? 0=NO
	DS	1	; UNUSED, BUT RESERVED, AT THIS TIME

;
;  SORT AND POINTER BUFFERS
;
N:
	DS	2	; NUMBER OF RECS
GAP:
	DS	2	; VARIABLE GAP
J:
	DS	2	; REC PTR 1
JG:
	DS	2	; REC PTR 2
IDX:
	DS	2	; INDEX PTR
PTPTR:
	DS	2	; 2-LEVEL INDIRECT PTR
PTFIL:
	DS	2	; REC PTR

;*
;*  START OF SORT ROUTINE
;*
SORT::
	PUSH	H	; SAVE REGS
	PUSH	D
	PUSH	B
	PUSH	PSW
	XCHG		; PTR IN HL
	LXI	D,SSB	; COPY HIS SORT BLOCK INTO MINE FOR EASIER ACCESS
	MVI	B,12	; 12 BYTES LONG
	CALL	MOVEB
	LHLD	RECNT	; GET RECORD COUNT
	SHLD	N	; SET "N"
	MOV	B,H	; ... IN BC
	MOV	C,L

;*
;*  CHECK FOR TRIVIAL CASE - 0 OR 1; DON'T DO IT IF SO
;*
	MOV	A,B	; SEE IF BC=1
	ORA	A	; B=0?
	JNZ	SHELL	; DO SORT IF B<>0
	MOV	A,C	; C=0 OR 1?
	CPI	2
	JC	SEXIT

;*
;*  SHELL SORT --
;*    THIS SORT ROUTINE IS ADAPTED FROM "SOFTWARE TOOLS"
;*    BY KERNIGAN AND PLAUGHER, PAGE 106.  COPYRIGHT, 1976, ADDISON-WESLEY.
;*  ON ENTRY, BC=NUMBER OF ENTRIES
;*
SHELL:
	LDA	SFLAG	; USE POINTERS?
	ORA	A	; 0=NO
	JZ	SORT2
	LHLD	FIRSTP	; PT TO FIRST RECORD
	XCHG		; POINTER TO 1ST RECORD IN DE
	LHLD	ORDER	; PT TO ORDER TABLE
;*
;*  SET UP ORDER TABLE; HL PTS TO NEXT ENTRY IN ORDER TABLE, DE PTS TO NEXT
;*    REC IN FILE, BC = NUMBER OF RECS REMAINING
;*
SORT1:
	MOV	A,B	; DONE?
	ORA	C	; 0 IF SO
	JZ	SORT2
	DCX	B	; COUNT DOWN
	MOV	M,E	; STORE LOW-ORDER ADDRESS
	INX	H	; PT TO NEXT ORDER BYTE
	MOV	M,D	; STORE HIGH-ORDER ADDRESS
	INX	H	; PT TO NEXT ORDER ENTRY
	PUSH	H	; SAVE PTR
	LHLD	RECSIZ	; HL=NUMBER OF BYTES/ENTRY
	DAD	D	; PT TO NEXT DIR1 ENTRY
	XCHG		; DE PTS TO NEXT ENTRY
	POP	H	; GET PTR TO ORDER TABLE
	JMP	SORT1
;*
;*  THIS IS THE MAIN SORT LOOP FOR THE SHELL SORT IN "SOFTWARE TOOLS" BY K&P
;*
SORT2:
	LHLD	N	; NUMBER OF ITEMS TO SORT
	SHLD	GAP	; SET INITIAL GAP TO N FOR FIRST DIVISION BY 2

;*  FOR (GAP = N/2; GAP > 0; GAP = GAP/2)
SRTL0:
	ORA	A	; CLEAR CARRY
	LHLD	GAP	; GET PREVIOUS GAP
	MOV	A,H	; ROTATE RIGHT TO DIVIDE BY 2
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A

;*  TEST FOR ZERO
	ORA	H
	JZ	SDONE	; DONE WITH SORT IF GAP = 0

	SHLD	GAP	; SET VALUE OF GAP
	SHLD	IDX	; SET I=GAP FOR FOLLOWING LOOP

;*  FOR (I = GAP + 1; I <= N; I = I + 1)
SRTL1:
	LHLD	IDX	; ADD 1 TO I
	INX	H
	SHLD	IDX

;*  TEST FOR I <= N
	XCHG		; I IS IN DE
	LHLD	N	; GET N
	MOV	A,L	; COMPARE BY SUBTRACTION
	SUB	E
	MOV	A,H
	SBB	D	; CARRY SET MEANS I > N
	JC	SRTL0	; DON'T DO FOR LOOP IF I > N

	LHLD	IDX	; SET J = I INITIALLY FOR FIRST SUBTRACTION OF GAP
	SHLD	J

;*  FOR (J = I - GAP; J > 0; J = J - GAP)
SRTL2:
	LHLD	GAP	; GET GAP
	XCHG		; ... IN DE
	LHLD	J	; GET J
	MOV	A,L	; COMPUTE J - GAP
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	SHLD	J	; J = J - GAP
	JC	SRTL1	; IF CARRY FROM SUBTRACTIONS, J < 0 AND ABORT
	MOV	A,H	; J=0?
	ORA	L
	JZ	SRTL1	; IF ZERO, J=0 AND ABORT

;*  SET JG = J + GAP
	XCHG		; J IN DE
	LHLD	GAP	; GET GAP
	DAD	D	; J + GAP
	SHLD	JG	; JG = J + GAP

;*  IF (V(J) <= V(JG))
	CALL	ICOMPARE	; J IN DE, JG IN HL

;*  ... THEN BREAK
	JC	SRTL1

;*  ... ELSE EXCHANGE
	LHLD	J	; SWAP J, JG
	XCHG
	LHLD	JG
	CALL	ISWAP	; J IN DE, JG IN HL

;*  END OF INNER-MOST FOR LOOP
	JMP	SRTL2

;*
;*  SORT IS DONE -- RESTRUCTURE FILE IN SORTED ORDER IN PLACE
;*
SDONE:
	LDA	SFLAG	; USE POINTERS?
	ORA	A	; 0=NO
	JZ	SEXIT	; DONE IF NO POINTERS
	LHLD	RECNT	; NUMBER OF RECORDS
	SHLD	J	; SAVE COUNT IN J
	LHLD	ORDER	; PTR TO ORDERED POINTER TABLE
	SHLD	PTPTR	; SET PTR PTR
	LHLD	FIRSTP	; PTR TO UNORDERED FILE
	SHLD	PTFIL	; SET PTR TO FILE BUFFER

;*  FIND PTR TO NEXT FILE ENTRY
SRTDN:
	LHLD	J	; GET ENTRY COUNT
	MOV	B,H	; ... IN BC
	MOV	C,L
	LHLD	PTPTR	; PT TO REMAINING POINTERS
	XCHG		; ... IN DE
	LHLD	PTFIL	; HL PTS TO NEXT FILE ENTRY

;*  FIND PTR TABLE ENTRY
SRTDN1:
	LDAX	D	; GET CURRENT POINTER TABLE ENTRY VALUE
	INX	D	; PT TO HIGH-ORDER POINTER BYTE
	CMP	L	; COMPARE AGAINST FILE ADDRESS LOW
	JNZ	SRTDN2	; NOT FOUND YET
	LDAX	D	; LOW-ORDER BYTES MATCH -- GET HIGH-ORDER POINTER BYTE
	CMP	H	; COMPARE AGAINST FILE ADDRESS HIGH
	JZ	SRTDN3	; MATCH FOUND
SRTDN2:
	INX	D	; PT TO NEXT PTR TABLE ENTRY
	DCX	B	; COUNT DOWN
	MOV	A,C	; END OF TABLE?
	ORA	B
	JNZ	SRTDN1	; CONTINUE IF NOT

;*  FATAL ERROR -- INTERNAL ERROR; POINTER TABLE NOT CONSISTENT
FERR$PTR:
	CALL	PRINT
	DB	0DH,0AH,'SORT Pointer Error',0
	JMP	CPM

;*  FOUND THE POINTER TABLE ENTRY WHICH POINTS TO THE NEXT UNORDERED FILE ENTRY
;*    MAKE BOTH POINTERS (PTR TO NEXT, PTR TO CURRENT UNORDERED FILE ENTRY)
;*    POINT TO SAME LOCATION (PTR TO NEXT FILE ENTRY TO BE ORDERED)
SRTDN3:
	LHLD	PTPTR	; GET PTR TO NEXT ORDERED ENTRY
	DCX	D	; DE PTS TO LOW-ORDER POINTER ADDRESS
	MOV	A,M	; MAKE PTR TO NEXT UNORDERED REC PT TO BUFFER FOR
	STAX	D	;   FILE REC TO BE MOVED TO NEXT UNORDERED FILE POS
	INX	H	; PT TO NEXT PTR ADDRESS
	INX	D
	MOV	A,M	; MAKE HIGH POINT SIMILARLY
	STAX	D

;*  INTERCHANGE NEXT ENTRY IN LINE WITH THE ENTRY CURRENTLY IN ITS POSITION
	LHLD	RECSIZ	; HL=NUMBER OF BYTES/ENTRY
	MOV	B,H	; BC=NUMBER OF BYTES/ENTRY
	MOV	C,L
	LHLD	PTFIL	; PT TO ENTRY
	XCHG

;*  COPY TO-BE-ORDERED FILE ENTRY TO NEXT ORDERED FILE POSITION
	LHLD	PTPTR	; POINT TO ITS POINTER
	MOV	A,M	; GET LOW-ADDRESS POINTER
	INX	H
	MOV	H,M	; GET HIGH-ADDRESS POINTER
	MOV	L,A	; HL IS ADDRESS OF UNORDERED ENTRY
	XCHG		; HL PTS TO ORDERED ENTRY TO BE MOVED, DE PTS TO REPL
SRTDN4:
	PUSH	B	; SAVE COUNT
	LDAX	D	; GET BYTES
	MOV	C,M
	XCHG		; EXCHANGE PTRS
	STAX	D	; PUT BYTE
	MOV	M,C
	XCHG		; RESTORE PTRS TO ORIGINAL
	POP	B	; GET COUNT
	INX	H	; PT TO NEXT
	INX	D
	DCX	B	; COUNT DOWN
	MOV	A,B	; DONE?
	ORA	C
	JNZ	SRTDN4

;*  POINT TO NEXT TARGET RECORD POSITION
	LHLD	RECSIZ	; GET SIZE OF RECORD
	XCHG		; ... IN DE
	LHLD	PTFIL	; PT TO ENTRY JUST PLACED
	DAD	D	; PT TO NEXT ENTRY
	SHLD	PTFIL	; SET POINTER FOR NEXT LOOP

;*  POINT TO NEXT ENTRY IN POINTER TABLE
	LHLD	PTPTR	; POINTER TO CURRENT REC
	INX	H	; PT TO NEXT REC
	INX	H
	SHLD	PTPTR

;*  COUNT DOWN
	LHLD	J	; GET COUNT
	DCX	H	; COUNT DOWN
	SHLD	J	; PUT COUNT
	MOV	A,H	; DONE?
	ORA	L
	JNZ	SRTDN

;*  EXIT
SEXIT:
	POP	PSW	; RESTORE REGS
	POP	B
	POP	D
	POP	H
	RET		; DONE

;*
;*  ISWAP -- Perform exchange of elements whose indices are in HL and DE
;*
ISWAP:
	LDA	SFLAG	; USE POINTERS?
	ORA	A	; 0=NO
	JNZ	SWAP	; DO POINTER SWAP
	CALL	ADRCOMP	; COMPUTE ADDRESS OF RECORDS FROM THEIR INDICES
	PUSH	H	; SAVE HL PTR
	LHLD	RECSIZ	; SIZE OF RECORD
	MOV	B,H	; ... IN BC
	MOV	C,L
	POP	H	; GET HL PTR
SWAPC:
	PUSH	B	; SAVE COUNT
	LDAX	D	; GET BYTES
	MOV	C,M
	MOV	M,A	; PUT BYTES
	MOV	A,C
	STAX	D	; PUT BYTES
	INX	H	; PT TO NEXT
	INX	D
	POP	B	; GET COUNT
	DCX	B	; COUNT DOWN
	MOV	A,B	; DONE?
	ORA	C
	JNZ	SWAPC
	RET

;*
;*  GIVEN INDICES IN HL AND DE, RETURN ADDRESSES OF RECORDS PTED TO BY
;*    THESE INDICES IN HL AND DE, RESP
;*
ADRCOMP:
	PUSH	H	; SAVE HL RECORD
	CALL	ADROFF	; COMPUTE OFFSET TO RECORD PTED TO BY DE
	SHLD	REC1	; SAVE ADDRESS OF RECORD
	POP	D	; GET OLD HL INDEX
	CALL	ADROFF	; COMPUTE OFFSET TO THE DESIRED RECORD
	XCHG		; ADDRESS IN DE
	LHLD	REC1	; GET ADDRESS
	XCHG		; ORIGINAL ORDER
	RET
REC1:
	DS	2	; TEMP STORAGE FOR SWAPC

ADROFF:
	LHLD	RECSIZ	; SIZE OF RECORD
	MOV	B,H	; ... IN BC
	MOV	C,L
	LXI	H,0	; OFFSET IN HL
ADRO1:
	DCX	D	; DECREMENT BY 1 SO BASE-RELATIVE
	MOV	A,D	; DONE WITH LOOP?
	ORA	E
	JZ	ADRO2
	DAD	B	; ADD IN RECORD SIZE
	JMP	ADRO1
ADRO2:
	XCHG		; OFFSET IN DE
	LHLD	FIRSTP	; PT TO FIRST ENTRY
	DAD	D	; ADD IN OFFSET
	RET

;*
;*  SWAP (Exchange) the pointers in the ORDER table whose indexes are in
;*    HL and DE
;*
SWAP:
	PUSH	H		; SAVE HL
	LHLD	ORDER		; ADDRESS OF ORDER TABLE
	MOV	B,H		; ... IN BC
	MOV	C,L
	POP	H
	DCX	H		; ADJUST INDEX TO 0...N-1 FROM 1...N
	DAD	H		; HL PTS TO OFFSET ADDRESS INDICATED BY INDEX
				;   OF ORIGINAL HL (0, 2, 4, ...)
	DAD	B		; HL NOW PTS TO POINTER INVOLVED
	XCHG			; DE NOW PTS TO POINTER INDEXED BY HL
	DCX	H		; ADJUST INDEX TO 0...N-1 FROM 1...N
	DAD	H		; HL PTS TO OFFSET ADDRESS INDICATED BY INDEX
				;   OF ORIGINAL DE (0, 2, 4, ...)
	DAD	B		; HL NOW PTS TO POINTER INVOLVED
	MOV	C,M		; EXCHANGE POINTERS -- GET OLD (DE)
	LDAX	D		; -- GET OLD (HL)
	XCHG			; SWITCH
	MOV	M,C		; PUT NEW (HL)
	STAX	D		; PUT NEW (DE)
	INX	H		; PT TO NEXT BYTE OF POINTER
	INX	D
	MOV	C,M		; GET OLD (HL)
	LDAX	D		; GET OLD (DE)
	XCHG			; SWITCH
	MOV	M,C		; PUT NEW (DE)
	STAX	D		; PUT NEW (HL)
	RET

;*
;*  ICOMPARE - Compares entries whose indices are in HL and DE; on exit,
;*	Carry Set means ((DE)) < ((HL)), Zero Set means ((HL)) = ((DE))
;*
ICOMPARE:
	LDA	SFLAG	; USE POINTERS?
	ORA	A	; 0=NO
	JNZ	COMPARE
	CALL	ADRCOMP	; COMPUTE ADDRESSES
	JMP	CALLCMP	; CALL COMPARE ROUTINE OF USER

;*
;*  COMPARE compares the entry pointed to by the pointer pointed to by HL
;*    with that pointed to by DE (1st level indirect addressing); on entry,
;*    HL and DE contain the numbers of the elements to compare (1, 2, ...);
;*    on exit, Carry Set means ((DE)) < ((HL)), Zero Set means ((HL)) = ((DE)),
;*    and Non-Zero and No-Carry means ((DE)) > ((HL))
;*
COMPARE:
	PUSH	H		; SAVE HL
	LHLD	ORDER		; ADDRESS OF ORDER
	MOV	B,H		; ... IN BC
	MOV	C,L
	POP	H
	DCX	H		; ADJUST INDEX TO 0...N-1 FROM 1...N
	DAD	H		; DOUBLE THE ELEMENT NUMBER TO POINT TO THE PTR
	DAD	B		; ADD TO THIS THE BASE ADDRESS OF THE PTR TABLE
	XCHG			; RESULT IN DE
	DCX	H		; ADJUST INDEX TO 0...N-1 FROM 1...N
	DAD	H		; DO THE SAME WITH THE ORIGINAL DE
	DAD	B
	XCHG

;*
;*  HL NOW POINTS TO THE POINTER WHOSE INDEX WAS IN HL TO BEGIN WITH
;*  DE NOW POINTS TO THE POINTER WHOSE INDEX WAS IN DE TO BEGIN WITH
;*	FOR EXAMPLE, IF DE=5 AND HL=4, DE NOW POINTS TO THE 5TH PTR AND HL
;* TO THE 4TH POINTER
;*
	MOV	C,M		; BC IS MADE TO POINT TO THE OBJECT INDEXED TO
	INX	H		; ... BY THE ORIGINAL HL
	MOV	B,M
	XCHG
	MOV	E,M		; DE IS MADE TO POINT TO THE OBJECT INDEXED TO
	INX	H		; ... BY THE ORIGINAL DE
	MOV	D,M
	MOV	H,B		; SET HL = OBJECT PTED TO INDIRECTLY BY BC
	MOV	L,C

;*
;*  COMPARE DIR ENTRY PTED TO BY HL WITH THAT PTED TO BY DE;
;*	NO NET EFFECT ON HL, DE; RET W/CARRY SET MEANS DE<HL
;*	RET W/ZERO SET MEANS DE=HL
;*
CALLCMP:
	PUSH	H	; SAVE HL ON STACK
	LHLD	CMPADR	; GET ADDRESS OF COMPARE ROUTINE IN HL
	XTHL		; ADDRESS OF COMPARE ROUTINE ON STACK AND RESTORE HL
	RET		; "CALL" ROUTINE AND RETURN TO SORT CORRECTLY

	END