;QSORT    VER: 1.5     AUGUST 23, 1978
;
;		Q	S	O	R	T
;
;
;	THIS IS THE GENERALIZED CP/M SORTING PROGRAM.
;	DESIGNED AND IMPLEMENTED BY:
;		STRUCTURED SYSTEMS GROUP
;
;		AUGUST 23, 1978
;
TPA		EQU	100H
		ORG	TPA
;
	JMP	STARTIT
	DB	'COPYRIGHT (C) 1977 STRUCTURED SYSTEMS GROUP'
LOGON	DB	'QSORT VER:'
	DB	'1.'
	DB	'5 $'
;
PATCHAREA:
		DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
		ORG	TPA+128D
READRECBUFF	DS	128D	;READING BUFFER
;
PRTMSG:
	PUSH D!PUSH H!PUSH B
	MVI	C,9D
	CALL	BDOS
	CALL	CRLF
	POP B!POP H!POP D
	RET
;
;
CRLF:
	MVI	A,0DH
	CALL	PCHAR
	MVI	A,0AH
	CALL	PCHAR
	RET
;
;
COMPDE:
	MOV	A,D
	CMA
	MOV	D,A
	MOV	A,E
	CMA
	MOV	E,A
	INX	D
	RET
;
;
CHITCHAT:
	LDA	INFOFLG
	ORA	A
	RZ
	CALL	PRTMSG
	RET
;
;
INCRNEXTAV:
	LDA	RECLEN
	MOV	C,A
	MVI	B,00H
	LHLD	NEXTAV
	DAD	B
	SHLD	NEXTAV
	RET
;
;
PCHAR:
	PUSH D!PUSH H!PUSH B
	MVI	C,2D
	MOV	E,A
	CALL	BDOS
	POP B!POP H!POP D
	RET
;
;
INTERROGATEDRIVE:
	PUSH D!PUSH H!PUSH B
	MVI	C,25D
	CALL	BDOS
	POP B!POP H!POP D
	RET
;
;
PRTPHRASE:
	PUSH D!PUSH H!PUSH B
	MVI	C,9D
	CALL	BDOS
	POP B!POP H!POP D
	RET
;
;
OPEN:
	PUSH D!PUSH H!PUSH B
	CALL	RESETDMA
	MVI	C,15D
	CALL	BDOS
	CPI	255D
	JZ	OPENERR
	POP B!POP H!POP D
	RET
;
CLOSE:
	PUSH D!PUSH H!PUSH B
	MVI	C,16D
	CALL	BDOS
	CPI	255D
	JZ	CLOSERR
	POP B!POP H!POP D
	RET
;
INCRNEXTFCB:
	LHLD	NEXTFCB
	LXI	D,FCBLEN
	DAD	D
	SHLD	NEXTFCB
	RET
;
SETDMAAD:
	PUSH D!PUSH H!PUSH B
	MVI	C,26D
	CALL	BDOS
	POP B!POP H!POP D
	RET
;
;
;
MAKE:
	PUSH D!PUSH H!PUSH B
	MVI	C,22D
	CALL	BDOS
	CPI	255D
	JZ	MAKERR
	POP B!POP H!POP D
	RET
;
RENAME:
	PUSH D!PUSH H!PUSH B
	MVI	C,23D
	CALL	BDOS
	POP B!POP H!POP D
	RET
;
WRITE:
	PUSH D!PUSH H!PUSH B
	MVI	C,21D
	CALL	BDOS
	CPI	1D
	JZ	WRITERR1
	CPI	2D
	JZ	WRITERR2
	CPI	255D
	JZ	WRITERR3
	POP B!POP H!POP D
	RET
;
;
READ:
	PUSH D!PUSH H!PUSH B
	MVI	C,20D
	CALL	BDOS
	CPI	2D
	JZ	READERR
	CPI	255D
	JZ	READERR
	POP B!POP H!POP D
	RET
;
;
SEARCHFIRST:
	PUSH D!PUSH H!PUSH B
	MVI	C,17D
	CALL	BDOS
	POP B!POP H!POP D
	RET
;
SEARCHNEXT:
	PUSH D!PUSH H!PUSH B
	MVI	C,18D
	CALL	BDOS
	POP B!POP H!POP D
	RET
;
DELETE:
	PUSH D!PUSH H!PUSH B
	MVI	C,19D
	CALL	BDOS
	POP B!POP H!POP D
	RET
;
STATUSMSGPRT:
	LDA	INFOFLG
	CPI	02H
	RNZ
	CALL	PRTMSG
	RET
;
DISKCHANGERTN:
	LDA	DCHANGE			;GET FLAG
	ORA	A			;TEST FOR ZERO
	RZ				;0=NO DISK CHANGE, 1=DISK CHANGE
	LDA	DRIVEOUT		;GET OUTPUT DRIVE
	ORA	A			;TEST FOR CURLOG DRIVE
	CZ	GETCURLOG		;IF CURLOG, GET IT
	ADI	'@'			;ADD TO GET ASCII CHAR
	STA	CHANGEMSGA		;STORE IT IN MSG
	CALL	CRLF
	LXI	D,CHANGEMSG
	CALL	PRTMSG
	CALL	GETCHAR			;WAIT FOR RETURN
	CALL	REINITBDOS
	RET
;
;
GETCURLOG:
	LDA	CURLOGDRIVE		;GET NO OF CURRENTLY LOGGED DISK
;
;
REINITBDOS:
	PUSH D!PUSH H!PUSH B
	MVI	C,13D
	CALL	BDOS
	POP B!POP H!POP D
	RET
;
GETCHAR:
	PUSH D!PUSH H!PUSH B
	MVI	C,1D
	CALL	BDOS
	POP B!POP H!POP D
	RET
;
;
;
;
;		S  T  A  R  T  I  T
;
STARTIT:
	LXI	SP,NEWSTACK	;GET ADDR OF NEW STACK AREA
	LXI	D,LOGON		;GET BEGIN MSG
	CALL	PRTMSG
	CALL	INTERROGATEDRIVE
	INR	A		;FOR USE IN SELECT RTN
	STA	CURLOGDRIVE	;SAVE THE CURRENTLY LOGGED DISK
	LXI	H,PARAM		;LOAD ADDR OF PARAMETER AREA
	CALL	GETPARAM	;GET PARAM INFO
	CALL	MAKETYPES	;GET OUTPUT FILE TYPE
	LXI	D,OUTFCB
	CALL	SETTYPETEMP	;OUTPUT TYPE MUST BE '$$$'
	CALL	CLEARFIL	;ERASE ANY OLD WORKFILES
;
;CALCULATE BUFFER SIZE
;
	LXI	D,FIRSTAV	;GET ADDR OF BEGINNING OF SORT BUFFER
	CALL	COMPDE		;COMPLEMENT REG DE
	LHLD	0006H		;GET ADDR OF TOP OF TPA FROM CP/M
	DAD	D		;SUBTRACT PRGM SPACE FROM IT
	SHLD	BSIZE		;SAVE BUFFER SIZE
;
;CALCULATE NUMBER OF RECORDS THAT WILL FIT IN BUFFER
;
	XCHG
	LDA	RECLEN		;GET RECORD LENGTH FIELD
	MOV	L,A		;PUT IT IN REG L
	MVI	H,00H		;ZERO HIGH ORDER BYTE OF DIVISOR
	CALL	DIVIDE		;DE=DE/HL REM IN HL
	CALL	COMPDE		;WE WILL SAVE ONLY THE COMPLEMENT
	XCHG			;PUT IN HL
	SHLD	LIMIT		;STORE NO OF RECS THAT CAN BE READ
;
;OPEN THE INPUT FILE
;
	LDA	DRIVEIN		;GET DRIVE SPEC FOR IN FILE
	CALL	SELECT		;SELECT THE DRIVE IT'S ON
	LXI	D,INFCB		;GET ADDR OF FCB OF INPUT FILE
	PUSH	D		;SAVE FCB PTR
	CALL	OPEN		;OPEN THE INPUT FILE
	POP	D		;RESTORE FCB PTR
	CALL	OPENMSG		;WRITE A MESSAGE ABOUT THE OPEN
;
;		Q S O R T      D R I V E R
;
;
DRIVER:
	CALL	READIN		;FILL THE BUFFER
	CALL	SORT1		;SORT THE BUFFER
	CALL	ROLLINPUTCNT
	LDA	EOFFLG		;HAS INPUT FILE EOFED?
	ORA	A		;TEST ACCUM
	JZ	DUMPWORKBUF	;NO, SO DUMP BUFFER TO0WRK EXTENT
;
;INPUT FILE HAS EOFED
;
	LDA	MERGEFLG	;GET THE MERGE NECCESSARY FLAG
	ORA	A		;TEST IT
	JZ	DUMPOUTBUF	;NOT NECESSARY SO DUMP BUFFER TO OUTPUT FILE
;
;LAST SORT PHASE WAS JUST COMPLETED
;
	CALL	OPENWORK	;OPEN A WORK EXTENT
	CALL	DUMPBUF		;WRITE OUT THE BUFFER TO THE WORK FILE
	CALL	OPENOUT		;OPEN THE OUTPUT FILE
	CALL	MERGE1		;MERGE THE WORK FILES ONTO THE OUPUT FILE
	JMP	EOJ		;  SORT AND MERGE COMPLETED
;
DUMPWORKBUF:
	MVI	A,01		;SET FLAG
	STA	MERGEFLG	;MERGE WILL BE NECESSARY
	CALL	OPENWORK	;OPEN A WORK EXTENT
	CALL	DUMPBUF		;WRITE OUT THE BUFFER TO THE WORK FILE
	JMP	DRIVER		;GET SOME MORE OFF THE DATA FILE
;
DUMPOUTBUF:
	CALL	OPENOUT		;OPEN THE OUTPUT FILE
	CALL	DUMPBUF		;WRITE OUT THE BUFFER TO THE OUTPUT FILE
	JMP	EOJ		;  SORT COMPLETED
;
;
;		R  E  A  D  I  N
;
;	FILL A BUFFER FROM THE INPUT FILE
;	THIS RTN WILL STOP IF THE BUFFER IS FULL OR IF EOF IS
;	REACHED.  AT EOF THE 'EOFFLG' IS SET ON (1).
;
READIN:
	LXI	D,LOADINGMSG
	CALL	STATUSMSGPRT
	LDA	DRIVEIN		;GET INPUT FILE DRIVE
	CALL	SELECT		;SELECT IT
	LXI	H,FIRSTAV	;GET ADDR OF SORTING BUFFER
	SHLD	NEXTAV		;RESET NEXT RECORD SPACE PTR
READNEXT:
	LHLD	NEXTAV		;GET PTR TO NEXT AVAILABLE
	XCHG
	LXI	H,INFCB		;GET ADDR OF INPUT FILE FCB
	CALL	READREC		;GET A LOGICAL RECORD
	CPI	1		;TEST FOR EOF
	JZ	EOFONIN		;IF =1 THEN FILE HAS EOFED
	CALL	INCRNEXTAV
	LHLD	LIMIT		;GET NUMBER OF RECS THAT WILL FIT
	XCHG
	LHLD	RECCNT		;GET COUNT OF RECORDS READ THIS PASS
	INX	H		;ADD 1 TO IT
	SHLD	RECCNT		;STORE THE NEW SUM
	DAD	D		;SUBTRACT THE LIMIT
	XRA	A		;ZERO ACCUM FOR COMPARAND
	CMP	H
	JNZ	READNEXT
	CMP	L
	JNZ	READNEXT
;
;THE BUFFER IS NOW FULL
;
	RET			;DON'T SET ANY FLAGS
;
EOFONIN:
	MVI	A,1		;SET ON
	STA	EOFFLG		;  END OF FILE FLAG
	RET
;
;
OPENWORK:
	LDA	WRKDRIVE	;GET WORK FILE DRIVE NUMBER
	CALL	SELECT		;SELECT THE DRIVE
	LHLD	NEXTFCB		;GET ADDR OF FCB TO BE USED NEXT
	SHLD	CURFCB		;STORE IT IN CURRENT FCB PTR
	CALL	INCRNEXTFCB	;GET ADDR OF NEXT FCB
	LDA	WORKCNT		;GET NUMBER OF WORK EXTENTS OPEN
	INR	A		;ADD ONE
	STA	WORKCNT		;STORE THE NEW SUM
	CPI	MAXWORKFILES	;COMPARE IT TO THE LIMIT
	JP	OVERFLOWERR	;TOO MANY IS AN ERROR
	CALL	OPENOUTPUTFILE	;OPEN THE FILE POINTED TO BY CURFCB
	RET
;
OPENOUT:
	CALL	DISKCHANGERTN	;ALLOW USER TO CHANGE DISKS IF NEEDED
	LDA	DRIVEOUT	;GET DRIVE OF OUTPUT FILE
	CALL	SELECT
	LXI	H,OUTFCB	;GET ADDR OF OUTPUT FCB
	SHLD	CURFCB		;STORE ITS ADDR IN CURRENT PTR
	CALL	DELETEOLDOUT	;ERASE ANY PREVIOUS OUT FILE ;8/23/78
	CALL	OPENOUTPUTFILE	;OPEN FILE POINTED TO BY CURFCB
	RET
;
;
DELETEOLDOUT: 						;8/23/78
	XCHG			;PUT FCBPTR IN DE 	;8/23/78
	CALL	DELETE		;ERASE IT 		;8/23/78
	RET 						;8/23/78
;
OPENOUTPUTFILE:
	LHLD	CURFCB		;GET PTR TO FCB OF FILE TO BE OPENED
	XCHG			;PUT IT IN DE
	PUSH	D		;SAVE FCB PTR
	CALL	MAKE
;
	POP	D		;RESTORE FCB PTR
	CALL	OPENMSG		;ANNOUNCE IT
	RET
;
;
ROLLINPUTCNT:
	LHLD	RECCNT
	XCHG
	LHLD	TOTIN
	DAD	D
	SHLD	TOTIN
	LXI	H,0
	SHLD	RECCNT
	RET
;
;
DUMPBUF:
	LXI	H,FIRSTAV
	SHLD	NEXTAV		;RESET NEXT AVAILABLE PTR
	JMP	STARTDUMPING
;
OUTNEXT:
	LHLD	NEXTAV
	XCHG
	LHLD	CURFCB		;GET ADDR OF FILE THAT IS OU\PUTTED TO
	CALL	WRITEREC	;WRITE A LOGICAL RECORD
	CALL	INCRNEXTAV	;POINT TO NEXT RECORD IN SORT BUFFER
	LHLD	OUTCNT
	INX	H
	SHLD	OUTCNT
;
;IS THE BUFFER EMPTY?
;
STARTDUMPING:
	LHLD	CRECCNT
	XCHG
	LHLD	OUTCNT
	DAD	D		;SUBTRACT THE NO OF RECS IN BUFFER FROM IT
	XRA	A		;ZERO ACCUM FOR COMPARAND
	CMP	H
	JNZ	OUTNEXT
	CMP	L
	JNZ	OUTNEXT
;
;THE BUFFER IS NOW EMPTY
;
	CALL	ROLLOUTPUTCNT
	LHLD	CURFCB
	CALL	CLOSEIT		;WRITE REMAINDER OF BUFFER AND CLOSE FILE
	RET
;
;
ROLLOUTPUTCNT:
	LHLD	OUTCNT
	XCHG
	LHLD	TOTOUT
	DAD	D
	SHLD	TOTOUT
	LXI	H,0
	SHLD	OUTCNT
	RET
;
;
;
;
;		S   O   R   T   1
;
;	THIS RTN IS THE SORTING DRIVER.
;
SORT1:
	LXI	D,SORTINGMSG
	CALL	STATUSMSGPRT
SORT2:				;THIS LABEL IS CALLED BY MERGE1
	LHLD	RECCNT		;GET NUMBER OF RECORDS IN SORT BUFFER
	SHLD	MI		;MI HOLDS MAXIMUM NO OF RECS IN BUFFER
	XCHG
	CALL	COMPDE
	XCHG
	SHLD	CRECCNT		;TO EASE THE MATH BURDEN, THE 
				;RECORD COUNT IS NOW IN TWOS
				;COMPLEMENT FORM
;
	CALL	LESSTHANTWO	;IF LESS THAN TWO...DON'T BOTHER SORTING
	JC	ENDSORT		;CY=1 IF <2, CY=0 IF >=2
;
NEWMI:
	ANA	A	;CLEAR THE CARRY BIT
	LDA	MI+1	;HIGH ORDER
	RAR
	STA	MI+1
	LDA	MI	;LOW ORDER
	RAR
	STA	MI
	LHLD	MI	;GET MI
	MOV	A,H	;PUT H IN THE ACCUM
	ORA	A	;IS IT EQUAL TO ZERO?
	JNZ	NOTZERO
	MOV	A,L	;PUT L IN THE ACCUM
	ORA	A
	JNZ	NOTZERO
	JMP	ENDSORT	;BRANCH TO END OF SORT RTN
NOTZERO:
	LHLD	MI
	XCHG
	CALL	COMPDE
	LHLD	RECCNT	;GET N
	DAD	D	;ADD(SUBTRACT) MI COMPLEMENT FROM N.
	SHLD	K	;STORE THE ANSWER IN K
	LXI	H,0001H	;SET J EQUAL TO
	SHLD	J	;      ONE.
SETI:
	LHLD	J	; MOVE J TO I
	SHLD	I
SETL:
	LHLD	I	;PUT I IN H,L
	XCHG		;PUT I IN D,E
	LHLD	MI	;PUT MI IN H,L
	DAD	D	;ADD THEM
	SHLD	LI	;STORE SUM IN LI
	LDA	HEAPFLG		;TELLS IF SORT IS NORMAL OR HEAPER
	ORA	A		;TEST FOR ZERO
	JNZ	HEAP1		;IF NOT ZERO THEN IT IS A HEAPING
	CALL	CALCADDR	;CALCULATE ADDRESS OF ELEMENTS
	CALL	COMPKEY		;COMPARE THE KEYS
;
;IF A SWITCH IS NECESSARY SWAPFLAG WILL EQUAL '1'
;IF A SWITCH IS NOT NECESSARY IT WILL EQUAL   '0'
;
	LDA	SWAPFLAG	;GET THE INDICATOR
	ORA	A		;TEST FOR ZERO
	JZ	INCRJ		;IF ZERO, GO INCREMENT J
	CALL	SWITCH		;SWITCH THE ELEMENTS IN THE BUFFER
	JMP	SKIPHEAP	;AVOID THE FOLLOWING CODE
HEAP1:
	CALL	HCALC		;CALCULATE ADDRESS OF HEAP ELEMENTS
	CALL	COMPKEY		;COMPARE THE KEYS
	LDA	SWAPFLAG	;GET THE INDICATOR
	ORA	A		;TEST FOR ZERO
	JZ	INCRJ		;IF ZERO, GO INCREMENT J
	CALL	HSWITCH		;SWITCH THE ELEMENTS IN THE HEAP
SKIPHEAP:
	LHLD	MI
	XCHG
	CALL	COMPDE
	LHLD	I	;GET I
	DAD	D	;SUBTRACT M FROM I
	SHLD	I	;GIVING I
	DCX	H	;ADD 1 TO I FOR TEST
	MOV	A,H	;MOVE H TO THE ACCUM
	ORA	A	;TEST SIGN
	JP	SETL	;IF I+1 IS MINUS THEN I<1 SO DON'T JUMP
INCRJ:
	LHLD	J
	INX	H
	SHLD	J
                ;
;	IS J GREATER THAN K?
;
	LHLD	J
	XCHG
	CALL	COMPDE
	LHLD	K	;GET K
	DAD	D	;SUBTRACT J FROM K
	MOV	A,H	;PUT H IN THE ACCUM
	ORA	A	;IS THE DIFFERENCE NEGATIVE?
	JM	NEWMI	;IF MINUS, J>K SO JUMP
	JMP	SETI	;J<=K
;
;		END OF SORT
;
ENDSORT:
	RET		;RETURN TO CALLER
;
;
;
LESSTHANTWO:
	LHLD	RECCNT		;GET NUMBER OF RECORDS IN BUFFER
	XRA	A		;GET ZEROS FOR COMPARE
	CMP	H		;IS HIGH ORDER A ZERO?
	JNZ	MORETHANONE	;NO, SO SPLIT
	CMP	L		;LOOK AT LOW ORDER
	JZ	NONEORONE	;IF ZERO, RECCNT IS ZERO
	INR	A		;COMPARE IT TO A ONE NOW
	CMP	L		;
	JNZ	MORETHANONE	;IF NOT EQUAL THAN >1
NONEORONE:
	STC			;SET CARRY BIT
	RET
;
MORETHANONE:
	XRA	A		;CLEAR THE CARRY BIT
	RET
;
;
;
;
CALCIOBSIZE:
	LHLD	BSIZE		;GET SIZE OF SORT BUFFER
	LXI	D,STARTIOB-ENDIOB	;COMPLEMENT OF OUTPUT BUFFER SIZE
	DAD	D		;SUBTRACT TO GET SIZE OF MERGE BUFFER
	LDA	WORKCNT		;GET NUMBER OF WORKFILES OPENED
	MOV	E,A
	MVI	D,0		;ZERO HI ORDER
	XCHG			;DE=DE/HL
	CALL	DIVIDE		; -- MERGEBUFSIZE/NOOFFILES
	DCR	D		;SUBTRACT 256D 
	JZ	OVERFLOWERR	;BUFFER IS TOO SMALL AND FILES TOO MANY
	MVI	E,0		;ZERO LOW ORDER
	XCHG			;PUT IN HL
	SHLD	IOBSIZE		;(SIZE-256D) OF WORKFILE BUFFERS
;
	LXI	H,ENDIOB	;GET ADDR OF END OF OUTPUT BUFFER
	SHLD	NEXTAV		;STORE THE BEGINNING OF IO BUFFER AREA
	RET			;  ALL DONE
;
;
;		G E T P A R A M
;
;	THIS RTN READS THE PARAMETER FILE WHOSE NAME IS SPECIFIED
;	ON THE COMMAND-LINE AND WHOSE TYPE IS 'SRT'.  IT READS IN
;	64D BYTES WITH ALL KEY INFORMATION AND OTHER PARAMETERS.
;
GETPARAM:
	LXI	H,TBUFF		;GET ADDR OF COMMAND-LINE BUFFER
	XRA	A		;ZERO ACCUM FOR COMPARAND
	CMP	M		;HOW LONG IS COMMAND-LINE?
	JZ	ASKPARMNAME	;GET PARM FILE NAME FROM CONSOLE
	LXI	D,TFCB		;GET ADDR OF CP/M FCB
	CALL	SETTYPESRT	;MAKE THE TYPE='SRT'
	LDA	TFCB		;GET THE SPECIFIED DRIVE
	CALL	SELECT		;SELECT IT
	LXI	D,TFCB		;GET ADDR OF FCB
	PUSH	D		;SAVE FCB PTR
	CALL	OPEN
	POP	D		;RESTORE FCB PTR
	CALL	READ
	LXI	D,PARAM		;GET ADDR OF PARAMETER STORAGE AREA
	LXI	H,TBUFF		;GET ADDR OF I/O BUFFER WHERE PARAMS ARE
	MVI	C,64D		;MOVE 64 BYTES TO STORAGE AREA
	CALL	MOVEIT
	CALL	MAKEFCBS	;PREPARE INPUT AND OUTPUT FCBS
	CALL	MAKEKEYS	;PREPARE KEY COUNT, MASKS, ETC
	CALL	SETWORKDRIVES
	RET
;
MAKEFCBS:
	LXI	H,DRIVEOUT
	LXI	D,OUTFCB	;GET ADDR OF OUTPUT FILE FCB
	MVI	C,12D		;FN+FT+DRIVE=12
	CALL	MOVEIT
;
	LXI	H,DRIVEIN
	LXI	D,INFCB		;GET ADDR OF INPUT FILE FCB
	MVI	C,12D
	CALL	MOVEIT
	RET
;
SETWORKDRIVES:
	LDA	WRKDRIVE		;GET DRIVE SPEC
	ORA	A			;IS IT CURLOG?
	CZ	GETCURLOG		;IF YES, GET CURLOG
	MVI	C,MAXWORKFILES		;ITERATE FOR AS MANY FCBS
	LXI	D,FCBLEN		;INCREMENT BY LENGTH OF FCB
	LXI	H,WORKFCBS		;START ADDR
SWD1:
	MOV	M,A			;STORE WORK DRIVE BYTE
	DAD	D			;INCREMENT PTR
	DCR	C			;DECREMENT COUNT
	JNZ	SWD1			;IF MORE, ITERATE
	RET
;
;
;
ASKPARMNAME:
				;THIS IS A DUMMY RTN.  IN THE FUTURE IT
				;SHOULD REQUEST A SORT PARAMETER FILE NAME
				;FROM THE CONSOLE.
	JMP	PARAMERR	;BOMB OUT
;
;
OPENMSG:
	PUSH	D		;SAVE FCB PTR
	LXI	H,MSG3A
	XCHG
	MVI	C,14D		;GET NO OF BYTES TO BLANK
	PUSH	D		;SAVE PTR TO MSG3A
	CALL	BLANKIT		;BLANK OUT THE LAST FILE NAME
	POP	D		;RESTORE PTR
	INX	H		;POINT TO FILENAME IN FCB
	MVI	B,8D		;EIGHT CHARS IN NAME
	MVI	C,' '		;GET COMPARAND
NEXTCHAR:
	MOV	A,M		;GET A CHAR OF NAME
	CMP	C		;IS IT A BLANK?
	JZ	ENDOFNAME	;YES SO PRINT IT
	STAX	D		;STORE THE NONBLANK CHAR IN MSG
	INX	D
	INX	H
	DCR	B		;ONLY EXAMINE 8 CHARS
	JZ	ENDOFNAME
	JMP	NEXTCHAR
;
ENDOFNAME:
	POP	B		;FCB PTR
	LXI	H,9D		;FCB+9 POINTS TO FILETYPE
	DAD	B		;ADD FCB+9, PTR IS IN HL
	MVI	A,' '		;COMPARAND
	CMP	M		;IS FIRST BYTE OF TYPE A BLANK?
	JZ	DOMSG		;YES, SO DONT PRINT TYPE
	MVI	A,'.'		;THERE IS A TYPE SO GET A DOT
	STAX	D		;PUT IT IN THE MESSSAGE
	MVI	C,3D		;LOOP COUNTER
;
EN1:
	MOV	A,M		;GET NEXT CHAR OF TYPE
	INX	D
	STAX	D		;STORE NEXT CHAR OF TYPE
	INX	H
	DCR	C		;DECREMENT BYTE COUNT
	JNZ	EN1		;REPEAT 3 TIMES
DOMSG:
	LXI	D,MSG3		;GET JUST OPENED MESSAGE
	CALL	OPENMSGOUT	;LIKE CHITCHAT ONLY WILL PRINT A '$'
	RET
;
BLANKIT:
	MVI	A,' '		;GET A BLANK
BL1:
	STAX	D		;DE IS PTR TO DESTINATION
	INX	D
	DCR	C		;DECREMENT LOOP COUNT
	JNZ	BL1		;LOOP IF MORE
	RET			;  ALL DONE
;
;
OPENMSGOUT:
	LDA	INFOFLG	
	CPI	02H		;IF =2 THEN STATUSMSG WANTED
	RNZ			;RETURN IF NO CHITCHAT WANTED
	CALL	OMO1		;DO THE PRINTING
	CALL	CRLF
	RET
;
OMO1:
	MVI	B,'%'		;THIS WILL STOP PRINTING
OMO2:
	LDAX	D		;GET A CHARACTER
	CMP	B		;IS IT A '%'?
	RZ			;IF YES, THEN MSG IS DONE
	CALL	PCHAR		;PRINT ACCUM
	INX	D
	JMP	OMO2		;LOOP
;
;
;
;		M  E  R  G  E
;
;	EXTERNAL MERGING ALGORITHM FOR QSORT
;
;		JULY 12, 1977
;
;
MERGE1:
	LXI	D,MERGINGMSG
	CALL	STATUSMSGPRT
	CALL	CALCIOBSIZE
	XRA	A		;GET ZEROS
	STA	HEAPCNT		;ZERO NUMBER OF ENTRIES IN HEAP
	LDA	WORKCNT		;GET NUMBER OF WORKFILES OPENED
	MOV	B,A		;PUT IT IN B
	LXI	H,WORKFCBS	;GET ADDR OF FIRST FCB
	XCHG			;PUT IT IN DE WHERE IT WILL
				;  REMAIN THRUGHOUT THE HEAP LOADING.
LOADLOOP:
	MOV	A,B		;GET NO OF WORKFILES LEFT INTO A
	ORA	A		;TEST FOR ZERO
	JZ	STARTMERGE	;IF ZERO, ALL FILES HAVE BEEN READ.
	LDA	HEAPCNT		;GET NO OF ENTRIES
	INR	A		;ADD ONE
	STA	HEAPCNT		;STORE NEW SUM
	PUSH	B		;   SAVE
	PUSH	D		;      ENVIRONMENT
	CALL	OPEN		;OPEN FILE
	POP	D		;RESTORE FCB ADDR
	PUSH	D		;SAVE FCB ADDR AGAIN
	CALL	IOREAD		;READ A RECORD
	CPI	1		;TEST FOR EOF			5/11/78
	JZ	NULLWORKFILE	;PROCESS THE EOF		5/11/78
	XCHG			;PUT REC PTR IN HL
	POP	D		;RESTORE FCB PTR
	PUSH	D		;SAVE FCB PTR AGAIN
	LDA	HEAPCNT		;GET SUBSCRIPT
	CALL	PUTHEAP		;PUT HL & DE IN HEAP(ACCUM)
	POP	D		;GET FCB ADDR
	LXI	H,FCBLEN	;FCB LENGTH IN HL (33+4 EXTRA)
	DAD	D		;ADD CURRENT FCB ADDR
	XCHG			;PUT IT IN DE
	POP	B		;RESTORE FILE CNT
	DCR	B		;DECREMENT NO OF WORKFILES LEFT
	JMP	LOADLOOP	;LOAD ANOTHER RECORD
;
NULLWORKFILE:							;5/11/78
	POP	D		;BALANCE THE REGS		5/11/78
	POP	B		;BALANCE THE REGS		5/11/78
	LDA	HEAPCNT		;GET THE NUMBER OF FILES	5/11/78
	DCR	A		;SUBTRACT ONE			5/11/78
	STA	HEAPCNT		;PUT IT BACK			5/11/78
	JMP	STARTMERGE	;GO MERGE			5/11/78
;
;
STARTMERGE:
	MVI	A,01H		;PUT 1 IN ACCUM
	STA	HEAPFLG		;SET ON HEAPFLAG SO SORT1 WILL KNOW
	LDA	HEAPCNT
	MOV	L,A
	MVI	H,0
	SHLD	RECCNT		;SET UP NO OF RECORDS FOR SORT TO SORT
	CALL	SORT2		;SORT THE HEAP
;
MRGLOOP:
;
	CALL	NODEOUT		;WRITE OUT THE LOW ST RECORD
	CALL	NODEIN		;READ IN THE LOWEST RECORD
	CPI	01H		;CHECK RETURN CODE
	CZ	ONELESS		;IF EOF, MAKE HEAP HAVE ONE LESS
	LDA	HEAPCNT		;GET NUMBER OF ENTRIES IN HEAP RIGHT NOW
	CPI	00		;ARE WE FINISHED?
	JZ	ENDMERGE	;YOU BET WE ARE!
	CALL	REHEAP		;REARRANGE THE HEAP
	JMP	MRGLOOP		;ONE MORE TIME
;
;
ENDMERGE:
	LXI	D,OUTFCB
	PUSH	D
	CALL	IOCLOSE		;EMPTY REMAINDER OF OUTPUT BUFFER
	CPI	1D		;THESE ERROR TESTS INSTALLED 2/21/78
	JZ	WRITERR1
	CPI	2D
	JZ	WRITERR2
	CPI	255D
	JZ	WRITERR3
	POP	D
	CALL	CLOSE		;BDOS CLOSE
	RET
;
;
NODEOUT:
	MVI	A,01H		;FIRST NODE
	CALL	GETHEAP		;HL POINTS TO REC, DE POINTS TO FCB
	PUSH	D		;SAVE FCB PTR
	LXI	D,OUTFCB	;GET ADDR OF FCB OF OUTPUT FILE
	CALL	IOWRITE		;WRITE OUT THE RECORD
	CPI	1D		;THESE ERROR CALLS INSTALLED 2/21/78
	JZ	WRITERR1
	CPI	2D
	JZ	WRITERR2
	CPI	255D
	JZ	WRITERR3
	POP	D		;RESTORE THE FCB PTR
	RET			;EXIT
;
;
NODEIN:
	PUSH	D		;SAVE THE FCB PTR
	CALL	IOREAD		;GET A LOGICAL RECORD
	XCHG			;PUT PTR TO REC IN HL
	POP	D		;RESTORE FCB PTR
	PUSH	D		;SAVE IT AGAIN
	CPI	01H		;TEST FOR EOF
	JZ	NODEIN1		;IF EOF THEN SET ON ONELESS FLAG
;
;ERROR CHECK
;
	MVI	A,01H		;FIRST NODE
	CALL	PUTHEAP		;PUT NEW RECORD INFO IN FIRST NODE
	XRA	A		;ZERO OUT ONELESS FLAG
	POP	D		;RESTORE FCB PTR
	RET			;ALL DONE
;
NODEIN1:
	MVI	A,1		;SET ON ONELESS FLAG
	POP	D		;RESTORE FCB PTR
	RET
;
;
ONELESS:
	PUSH	D		;SAVE FCB PTR
	MVI	A,01H		;FIRST NODE
	STA	LI		;STORE IN SORTING SUBSCRIPT
	LDA	HEAPCNT		;GET SUB OF LAST ENTRY
	STA	I		;STORE IN SORTING SUBSCRIPT
	CALL	HSWITCH		;EXCANGE THEM
	LDA	HEAPCNT		;GET NO OF ELEMENTS
	DCR	A		;DECREMENT
	STA	HEAPCNT		;STORE NEW SUM
	POP	D		;RESTORE FCB PTR
	RET			;EXIT
;
;
REHEAP:
	MVI	A,01H		;GET A ONE
	STA	NODE		;START WITH NODE 1
CONTINUEHEAPING:
	LDA	NODE		;GET CURRENT NODE
	ADD	A		;NODE=NODE*2
	MOV	B,A		;CHILD1 IN REG B
	LDA	HEAPCNT		;GET NO OF ELEMENTS IN HEAP
	CMP	B		;COMPARE TO CHILD1
	RC			;IF HEAPCNT<NODE*2, THERE ARE NO KIDS
 	JZ	ONEKID		;   EQUAL
	JMP	DONTGO		;   THERE ARE TWO KIDS AT LEAST
ONEKID:				;ONLY 1 CHILD OF THIS NODE
	STA	SMALLEST	;CHILD1=HEAPCNT SO PUT IN SMALLEST
	JMP	COMP2		;GO COMPARE NODE TO FIRST KID
DONTGO:
	MOV	A,B		;PUT CHILD1 IN ACCUM
	STA	CHILD1		;STORE FIRST KID
	INR	A
	STA	CHILD2		;STORE SECOND KID
;
;COMPARE THE TWO CHILDREN
;
	LDA	CHILD1		;GET SUB OF KID1
	CALL	GETHEAP		;GET ITS PTR
	SHLD	REC1		;SAVE ITS PTR
	LDA	CHILD2		;GET SUB OF KID2
	CALL	GETHEAP		;GET ITS PTR
	SHLD	REC2		;SAVE IT
	CALL	COMPKEY		;COMPARE THE TWO RECORDS
	LDA	SWAPFLAG	;GET RETURN CODE
	ORA	A		;TEST FOR NOT ZERO
	JNZ	SKIP16		;CHILD1<=CHILD2
	LDA	CHILD2		;GET SUB OF KID2
	STA	SMALLEST	;MAKE IT THE SMALLEST
	JMP	COMP2
SKIP16:
	LDA	CHILD1		;GET SUB OF KID1
	STA	SMALLEST	;MAKE IT THE SMALLEST
;
;COMPARE THE NODE AND ITS SMALLEST CHILD
;
COMP2:
	LDA	NODE		;GET SUB OF NODE
	CALL	GETHEAP		;GET ITS RECORD PTR
	SHLD	REC1		;SAVE IT FOR COMPARE
	LDA	SMALLEST	;GET SUB OF SMALLEST KID
	CALL	GETHEAP		;GET ITS RECORD PTR
	SHLD	REC2		;SAVE IT FOR COMPARE
	CALL	COMPKEY		;COMPARE THE TWO RECORDS
	LDA	SWAPFLAG	;GET RETURN CODE
	ORA	A		;TEST FOR ZERO
	RNZ			;IF NOT ZERO, HEAP IS IN ORDER SO RETURN
	CALL	SWAPHEAPPTRS	;IF NOT, SWAP THE HEAP PTRS
	LDA	SMALLEST	;GET SUB OF WHERE THE OLD NODE IS
	STA	NODE		;MAKE IT THE NEW NODE
	JMP	CONTINUEHEAPING	;   DO IT AGAIN
;
;
SWAPHEAPPTRS:
	LDA	NODE
	STA	LI		;STORE IN SORTING SUBSCRIPT
	LDA	SMALLEST	;GET SUB OF SMALLEST
	STA	I		;STORE IN SORTING SUBSCRIPT
	CALL	HSWITCH		;SWAP THE 4 BYTE POINTERS
	RET
;
;
GETHEAPADDR:
	LXI	H,HEAPBOTM	;GET ADDR OF HEAP
	ADD	A		;SUB=SUB*2
	ADD	A		;SUB=SUB*2
	MOV	C,A
	MVI	B,0
	DAD	B		;GET DISPLACEMENT IN HEAP
	RET
;
;
GETHEAP:
	DCR	A		;ADD ZERO FOR FIRST ENTRY
	LXI	H,HEAPBOTM	;GET ADDR OF HEAP
	ADD	A		;SUB=SUB*2
	ADD	A		;SUB=SUB*2 -- 4 BYTES PER ENTRY
	MOV	C,A		;PUT SUB IN C
	MVI	B,00H		;ZERO HIGH ORDER
	DAD	B		;HL POINTS TO THE FCB PTR
	MOV	E,M		;LOW TO LOW
	INX	H		;POINT TO NEXT BYTE
	MOV	D,M		;HIGH TO HIGH
	INX	H		; ADD ONE
	MOV	C,M
	INX	H		; ADD ONE MORE SO HL POINTS TO RECORD
	MOV	H,M
	MOV	L,C
	RET
;
;
PUTHEAP:
	DCR	A		;ADD ZERO FOR FIRST ENTRY
	PUSH	H		;SAVE RECORD POINTER
	LXI	H,HEAPBOTM	;GET ADDR OF HEAP
	ADD	A		;SUB=SUB*2
	ADD	A		;SUB=SUB*2 -- 4 BYTES PER ENTRY
	MOV	C,A		;PUT SUB IN LOW ORDER
	MVI	B,00H		;ZERO HIGH ORDMR
	DAD	B		;HL POINTS TO FIRST BYTE OF ELEM
	MOV	M,E		;STORE LOW ORDER FCB PTR
	INX	H		;POINT TO NEXT BYTE
	MOV	M,D		;STORE HIGH ORDER FCB PTR
	POP	D		;RESTORE RECORD POINTER
	INX	H
	MOV	M,E		;STORE LOW ORDER REC PTR
	INX	H
	MOV	M,D		;STORE HIGH ORDER REC PTR
	RET
;
;
;
;		D   I   V   I   D   E
;
;THIS PROGRAM IS FROM THE INTEL LIBRARY.
;REFERENCE NUMBER: BB9       PAGE: 5-33
;
;16 BIT DIVISION GIVING 16 BIT QUOTIENT AND 16 BIT REMAINDER
;ON ENTRY:
;	DE HOLDS DIVIDEND
;	HL HOLDS˙DIVISOR
;ON EXIT:
;	DE HOLDS RESULT
;	HL HOLDS REMAINDER
;
;
DIVIDE:
	SHLD	ZTEMP	;SAVE DIVIDEND IN TEMP
	LXI	H,ZNUM	;STORE
	MVI	M,11H	;   BIT COUNT
	LXI	B,0000H	;INITIALIZE RESULT
	PUSH	B	;SAVE RESULT ON STACK
ZLOOP:
	MOV	A,E	;GET LOW DIVISOR BYTE
	RAL
	MOV	E,A
	MOV	A,D
	RAL
	MOV	D,A
	DCR	M
	POP	H
	RZ		;ZERO BIT COUNT MEANS ALL DONE
	MVI	A,0	;ADD IN
	ACI	0	;  CARRY
	DAD	H	;SHIFT TEMP RESULT LEFT ONE BIT
	MOV	B,H	;COPY HL TO AC
	ADD 	L
	LHLD	ZTEMP	;GET ADDR OF DIVIDEND
	SUB 	L	;SUBTRACT FROM
	MOV	C,A
	MOV	A,B
	SBB	H	;    TEMPORARY RESULT
	MOV	B,A
	PUSH	B	;SAVE TEMP RESULT ON STACK
	JNC	ZSKIP	;NO BORROW FROM SUBTRACT
	DAD	B	;  ADD DIVIDEND BACK IN
	XTHL		;REPLACE TEMP RESULT ON STACK
ZSKIP:
	LXI	H,ZNUM	;RESTORE HL
	CMC		;COMPLEMENT CARRY
	JMP	ZLOOP	;REPEAT LOOP STEPS
ZTEMP	DS	2
ZNUM	DS	1
;
;
;		B  I  N  A  S  C
;
;CONVERTS A 16 BIT UNSIGNED BINARY VALUE INTO A 5 BYTE
;ASCII STRING OF EQUIVALENT VALUE.
;	THIS RTN ALSO ZERO SUPPRESSES
;
;ON ENTRY:
;	HL HOLDS A POINTER TO A 5 BYTE OUTPUT FIELD
;	DE HOLDS BINARY INTEGER
;ON EXIT:
;	ASCII EQUIVALENT IS IN MEMORY
;	BC & PSW ARE UNAFFECTED
;
BINASC:
	PUSH	PSW
	PUSH	B	;SAVE
	PUSH	H	;   ENVIRONMENT
	SHLD	ASCPTR	;SAVE PTR TO OUTPUT BUFFER
	MVI	M,30H	;INITIALIZE ASCII BYTE
	XRA	A	;ZERO ACCUM
	STA	LOOPCNT	;ZERO LOOP COUNTER
	LXI	H,POWERS 	;GET ADDR OF TOP OF POWER TABLE
	SHLD	POWPTR	;PUT IT IN CURRENT PTR
MLOOP:
	MOV	C,M	;PUT LOW ORDER IN C
	INX	H
	MOV	B,M	;PUT HIGH ORDER IN B
	INX	H	;POINT TO NEXT ONE
	SHLD	POWPTR	;SAVE PTR
MLOOP1:
	XCHG		;BIN IN HL, POWPTR IN DE
	SHLD	MSAVE	;SAVE BIN IN CASE IT MUST BE RESTORED
	DAD	B	;SUBTRACT THE POWER OF TEN
	JNC	MLT	;IF NO CARRY THEN BIN<POWER
	XCHG		;REMAINING BIN IN DE
	LHLD	ASCPTR	;GET PTR TO OUTBUFFER
	INR	M	;ADD 1 TO IT
	JMP	MLOOP1	;SUBTRACT THE SAME POWER AGAIN
;
MLT:
	LHLD	MSAVE	;RESTORE REMAINING BIN
	XCHG
	LDA	LOOPCNT	;GET LOOP COUNTER
	INR	A	;ADD 1
	STA	LOOPCNT	;STORE NEW SUM
	CPI	5D	;EQUAL FIVE?
	JZ	MPOP	;IF YES, NUMBER IS CONVERTED
	LHLD	ASCPTR	;GET OUT BUFFER PTR
	INX	H	;ADD 1 TO IT
	SHLD	ASCPTR	;STORE NEW SUM
	MVI	M,30H	;INITIALIZE ASCII BYTE
	LHLD	POWPTR	;PUT POWPTR IN HL TO BE INCREMENTED
	JMP	MLOOP	;DO NEXT POWER
;
MPOP:
	POP	H
	PUSH	H
	CALL	ZEROS		;ZERO SUPPRESS RESULT
	POP	H
	POP	B
	POP	PSW
	RET
;
                POWERS:
	DW	0D8F0H	;-10,000
	DW	0FC18H	; -1,000
	DW	0FF9CH	;   -100
	DW	0FFF6H	;    -10
	DW	0FFFFH	;     -1
LOOPCNT	DB	0	;LOOP COUNTER
POWPTR	DW	0	;HOLDS PTR TO CURRENT POWER
ASCPTR	DW	0	;HOLDS PTR TO CURRENT DECIMAL OUTPUT BYTE
MSAVE	DW	0	;TEMPORARY AREA
;
;		Z  E  R  O  S
;
;ON ENTRY:
;	HL POINTS TO 5 BYTE FIELD CONTAINING ASCII NUMBERS
;
;ON EXIT:
;	LEADING ZEROS ARE CONVERTED TO BLANKS
;	(IF NO SIG-FIGS, ONE ZERO IS LEFT)
;
ZEROS:
	MVI	C,4D	;GET LOOP COUNT
ZERLOOP:
	MOV	A,M	;GET A NUMBER
	CPI	'0'	;IS IT AN ASCII ZERO?
	RNZ		;IF NO, EXIT
	MVI	M,' '	;PUT A BLANK THERE
	INX	H	;INCREMENT NUMBER PTR
	DCR	C	;DECREMENT LOOP COUNT
	JNZ	ZERLOOP	;IF MORE NUMBERS, GO AGAIN
	RET
;
;
;		M A K E K E Y S
;
;	THIS RTN BUILDS THE KEY DATA AREA INCLUDING NUMBER OF
;	KEYS, MASKS.
;
MAKEKEYS:
	MVI	C,0		;ZERO THE KEY COUNT
	LXI	D,KEYDATA	;GET ADDR OF KEY DATA AREA IN PARM REC
	LDA	MAXKEYS		;GET MAXIMUM
	MOV	B,A
CHEKNEXT:
	LDAX	D		;GET POSITION OF KEY
	ORA	A		;TEST FOR ZERO
	JZ	CNTDONE		;IF POS IS ZERO THEN ITS THE LAST KEY
	INR	C		;INCREMENT KEY COUNT
	INX	D
	INX	D
	INX	D		;POINT TO A/N FLAG OF THIS KEY
	LDAX	D		;GET A/N FLAG
	CPI	'A'		;IS IT AN ALPHAMERIC FIELD?
	JNZ	NUMERIC1
	MVI	A,0DFH		;LOAD AND MASK
	STAX	D		;STORE IT BACK IN THE PARM FIELD
	JMP	SKIP9
NUMERIC1:
	MVI	A,0FFH		;LOAD AND MASK
	STAX	D		;STORE IT BACK IN THE PARM FIELD
SKIP9:
	INX	D		;POINT DE TO THE NEXT PARM STRING
	DCR	B		;DECREMENT NUMBER OF KEYS LEFT TO EXAMINE
	JNZ	CHEKNEXT	;IF MORE, GO CHECK THEM
;
CNTDONE:
;
;REGISTER C NOW HOLDS NUMBER OF KEYS SPECIFIED
;
	MOV	A,C
	STA	NOKEYS		;STORE THE NUMBER OF KEYS
	RET
;
;
;
CALCADDR:
	LHLD	LI		;GET INDEX LI
	CALL	CALCDISPLACEMENT
	SHLD	REC1		;STORE THE RECORDS ADDR
;
	LHLD	I		;GET INDEX I
	CALL	CALCDISPLACEMENT
	SHLD	REC2
	RET
;
CALCDISPLACEMENT:
	DCX	H		;SUBTRACT 1
	LDA	RECLEN		;GET RECORD LENGTH
	MOV	E,A		;PUT IT IN LOW ORDER
	MVI	D,00H		;ZERO HIGH ORDER
	CALL	MULT		;HL=(I-1)*RECORDLENGTH
	XCHG			;PUT PRODUCT IN DE
	LXI	H,FIRSTAV	;GET ADDR OF BOTTOM OF BUFFER
	DAD	D		;ADD THEM TO GET ADDR OF ELEM(I)
	RET
;
;
;		C  O  M  P  K  E  Y
;
COMPKEY:
	LDA	NOKEYS		;GET NUMBER OF KEYS SPECIFIED
	STA	CURKEY		;STORE IT IN CURRENT KEY FIELD
	LXI	H,SWAPFLAG
	MVI	M,00H		;RESET EXCHANGE FLAG FOR INITIAL COMPARE
;
NEXTKEY:
	LDA	CURKEY		;GET THE NUMBER OF THE CURRENT KEY
	DCR	A		;SUBTRACT ONE FROM IT
	STA	CURKEY		;STORE IT BACK
	MOV	L,A		;PUT IT IN LOW ORDER
	MVI	H,00H		;ZERO HIGH ORDER
	LXI	D,KEYSIZE	;PUT A FOUR IN AS MULTIPLIER
	CALL	MULT		;MULTIPLY (CURKEY-1) BY 3 TO GET PARM ADDR
	LXI	D,KEYDATA	;LOAD ADDR OF KEY PARAMS
	DAD	D		;ADD DISPLACEMENT TO PRODUCT FOR ABS ADDR
	SHLD	CURPARM		;STORE ADDR OF CURRENT 4 BYTE PARM STRING
	INX	H
	INX	H
	INX	H		;POINT TO A/N MASK
	MOV	A,M		;GET THE MASK
	STA	MASK		;STORE THE MASK
	LHLD	CURPARM		;GET ADDR OF KEY INFO
;
;
;THIS IS THE GENERALIZED BYTE COMPARE RTN.
;
;		REC1 - REC2 GIVES ONE OF THREE RESULTS:
;		IF DIFFERENCE=0 AND NO CARRY IS SET:    THEN REC1=REC2
;		IF DIFFERENCE<>0 AND CARRY IS SET:      THEN REC1<REC2
;		IF DIFFERENCE<>0 AND CARRY IS RESET:    THEN REC1>REC2
;
	MOV	B,M		;PUT POS IN B
	INX	H		;GET ADDR OF LENGTH OF THIS KEY
	MOV	A,M		;PUT KLEN IN A
	STA	CURBYTE		;PUT BYTE COUNT IN STORAGE
	DCR	A		;SUBTRACT ONE 
	ADD	B		;ADD POS TO (LEN-1)
	DCR	A
	MOV	E,A		;PUT SUM IN LOW ORDER
	MVI	D,00H		;ZERO THE HIGH ORDER
	LHLD	REC1		;GET ADDR OF FIRST REC
	DAD	D		;ADD THE DISPLACEMENT
;
;HL NOW HOLDS PTR TO LSBYTE OF CURRENT KEY IN ELEMENT(REC1)
;
	PUSH	H		;SAVE THE PTR
	LHLD	REC2		;GET ADDR OF REC2 REC
	DAD	D		;ADD THE DISPLACEMENT
	POP	D		;RESTORE THE PTR TO REC1
;HL NOW POINTS TO LSBYTE OF REC2
;DE NOW POINTS TO LSBYTE OF REC1
	XRA	A		;ZERO ACCUM
	STA	ZEROFLAG	;CLEAR ZERO RESULT FLAG
	PUSH	PSW		;CLEAR ACCUM AND RESET CARRY BIT ARE 
				;PRIMED BY PUSHING ONTO THE S\ACK
COMPNEXTBYTE:
	LDA	MASK		;GET MASK
	MOV	C,A		;MASK IN C
	MOV	A,M		;GET REC2
	ANA	C		;AND REC2 WITH MASK
	MOV	B,A		;PUT REC2 IN B
	LDAX	D		;GET REC1
	ANA	C		;AND REC2 WITH MASK
	MOV	C,A		;MOVE REC2 TO C
	POP	PSW		;GET CARRY FROM LAST BYTE COMPARE
	MOV	A,C		;PUT REC2 IN A,  REC1 IS IN B
	SBB	B		;SUBTRACT BYTE OF REC1 FROM REC2
	JZ	SKIP1		;IF RESULT IS ZERO SKIP
	MVI	A,01H		;TURN ON FLAG
	STA	ZEROFLAG	;SHOW THAT A NON-ZERO RESULT HAS BEEN DETECTED
SKIP1:
	PUSH	PSW		;SAVE THE BORROW BIT FROM THE SUBTRACT
	LDA	CURBYTE		;GET THE BYTE COUNT
	DCR	A		;DECREMENT COMPARAND BYTE COUNT
	STA	CURBYTE		;STORE THE NEW BYTE COUNT FOR NEXT TIME
	JZ	ENDCOMP		;IF ZERO, ALL BYTES HAVE BEEN COMPARED
	DCX	D		;POINT TO NEW REC2
	DCX	H		;POINT TO NEW REC1
	JMP	COMPNEXTBYTE	;CHECK THE NEXT BYTE
ENDCOMP:
	LHLD	CURPARM		;GET PTR TO PARAMETER STRING
	INX	H		;INCREMENT PTR TO POINT TO
	INX	H		;    ASCEND/DESCEND INDICATOR.
	POP	PSW		;GET LAST STATUS OF FLAGS
	JC	GT		;IF BORROW THEN A(REC1)>A(REC2)
	LDA	ZEROFLAG	;GET FLAG
	CPI	01H		;WAS THERE A NON-ZERO RESULT?
	JZ	LT		;IF NONZERO WITH NO BORROW THEN A(REC1)<A(REC2)
;EQUAL!
	JMP	ENDTEST		;IF KEYS WERE EQUAL, FLAGS AREN'T CHANGED
GT:
	MVI	A,'A'		;ASCENDING?
	CMP	M		;COMPARE TO INDICATOR
	JZ	SETON		;SET FLAG
	JMP	RESET		;RESET FLAG
LT:
	MVI	A,'D'		;DESCENDING?
	CMP	M		;COMPARE TO INDICATOR
	JZ	SETON		;SET FLAG
;
RESET:
	MVI	A,00H		;OFF
	STA	SWAPFLAG	;RESET SWAPFLAG
	JMP	ENDTEST		;EXIT
SETON:
	MVI	A,01H		;ON
	STA	SWAPFLAG	;SET SWAPFLAG
ENDTEST:
	LDA	CURKEY		;GET NUMBER OF KEYS LEFT
	CPI	00H		;ANY MORE KEYS?
	JNZ	NEXTKEY		;YES SO ITERATE
	RET			;NO END OF COMPARE RTN
;
;		S W I T C H
;
SWITCH:
;
	LHLD	REC1	;SOURCE IN HL
	LXI	D,RECBUF	;DEST IN DE
	LDA	RECLEN	;GET LOW ORDER BYTE OF LENGTH
	MOV	C,A	;SET LENGTH OF MOVE=LENGTH OF ELEMENT
	CALL	MOVEIT
	LHLD	REC1
	XCHG		;DEST IN DE
	LHLD	REC2	;SOURCE IN HL
	MOV	C,A	;LENGTH
	CALL	MOVEIT
	LHLD	REC2
	XCHG		;DEST IN DE
	LXI	H,RECBUF	;SOURCE IN HL
	MOV	C,A	;LENGTH
	CALL	MOVEIT
	RET
;
HSWITCH:
	LDA	LI			;GET SUBSCRIPT
	CALL	GETHEAP			;PUT ENTRY IN REGS
	MVI	A,MAXWORKFILES+1	;GET NUMBER OF SAFE ENTRY
	CALL	PUTHEAP
	LDA	I
	CALL	GETHEAP
	LDA	LI
	CALL	PUTHEAP
	MVI	A,MAXWORKFILES+1
	CALL	GETHEAP
	LDA	I
	CALL	PUTHEAP
	RET
;
;
;
;		M O V E I T
;
MOVEIT:
	PUSH	PSW	;SAVE ACCUMULATOR AND FLAGS
MOVBYTE:
	MOV	A,M	;GET SOURCE BYTE
	STAX	D	;PUT DESTINATION BYTE
	INX	H	;MOVE POINTERS
	INX	D	;  AHEAD ONE BYTE
	DCR	C	;REDUCE BYTE COUNT
	JNZ	MOVBYTE	;IF MORE BYTES, LOOP
	POP	PSW	;RESTORE THE ENVIRONMENT
	RET		;EXIT RTN
;
;
HCALC:
	LHLD	LI
	CALL	HCALCIT
	SHLD	REC1
;
	LHLD	I
	CALL	HCALCIT
	SHLD	REC2
	RET
;
HCALCIT:
	DCX	H
	LDA	HEAPLEN
	MOV	E,A
	MVI	D,00H
	CALL	MULT
	XCHG
	LXI	H,HEAPBOTM
	DAD	D
	INX	H
	INX	H			;MAKE HL POINT TO REC PTR OF HEAP ENTRY
	MOV	D,M
	INX	H
	MOV	H,M
	MOV	L,D
	RET
;
;
;		B U F F E R E D     I / O     R T N S
;
;	IOREAD, IOWRITE AND IOCLOSE ARE GENERALIZED IO RTNS THAT
;	USE BUFFERS WHOSE SIZE IS DETERMINED IN THE RTN CALCIOBSIZE
;	WHICH IS CALLED FROM THE MERGE1 RTN.  THESE IO RTNS ARE
;	ONLY USED TO READ IN THE WORK FILES AS INPUT TO THE MERGE
;	ALGORITHM AND TO WRITE OUT THE OUTPUT FILE FROM THE MERGE.
;
;
IOREAD:
	XCHG
	SHLD	FCBPTR		;ADDRESS OF FCB
	MVI	B,4
	LXI	D,33
	DAD	D
	LXI	D,BUFADPR	;ADDRESS OF BUFF ADDRESS PTR
LOOP0	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	LOOP0
;CHECK TO SEE IF FIRST TIME THROUGH
	XRA	A		;ZERO A
	LXI	H,BUFADPR
	CMP	M
	JNZ	CONT
	INX	H
	CMP	M
	JZ	SETUP		;FIELD IS ZEROES
	DCX	H
CONT:
	MOV	C,M		;C&E GET ADDRESS
	INX	H
	MOV	B,M
	LHLD	IOBSIZE
	DAD	B
	SHLD	TEMP1		;BUFF SIXE AND BUFF ADDRESS
	LDA	RECLEN
	MOV	E,A
	MVI	D,0
	LHLD	BUFPTR	
	MOV	A,M
	CPI	1AH		;EOF?
	JNZ	CONT1
	MVI	A,1
	LHLD	BUFPTR
	XCHG
	JMP	FINIS
CONT1:
	DAD	D
	SHLD	TEMP2
	XCHG			;D&E GET BUFPRT AND REC LENGTH
	LXI	H,TEMP1
	INX	H
	MOV	A,D
	CMP	M
	JC	CONT2
	JNZ	MOVB
	DCX	H
	MOV	A,E
	CMP	M
	JC	CONT2
	JZ	CONT2		;IS THIS RIGHT FOR BOTH = ?
MOVB:		;ARRIVE HERE ONLY IF
	CALL	MOVEBUF		;BUFFSIZE+BUFF ADDRESS < BUFF PTR+REC LENGTH
	CALL	READRS
CONT2:
	LHLD	TEMP2		;BUMP THE POINTER
	XCHG	
	LXI	B,35
	LHLD	FCBPTR
	DAD	B
	MOV	M,E
	INX	H
	MOV	M,D
	LHLD	BUFPTR
;
	MOV	A,M		;GET THE 1ST BYTE OF THE NEXT REC ;8/23/78
	CPI	1AH		;IS IT AN EOF MARK		;8/23/78
	JNZ	NOTEOFYET	;JUMP IF NO			;8/23/78
	MVI	A,1		;SET EOF FLAG ON		;8/23/78
	JMP	CONTINUEIT	;COMMON EXIT			;8/23/78
NOTEOFYET:							;8/23/78
	XRA	A		;SET EOF FLAG OFF		;8/23/78
CONTINUEIT:							;8/23/78
;
	XCHG
FINIS	RET
;
;ROUTINE TO MOVE DATA TO THE FRONT OF THE BUFFER
;
MOVEBUF:
	LHLD	IOBSIZE		;BUFFERSIZE
	XCHG	
	LHLD	BUFADPR		;BUFFER ADDRESS
	DAD	D
	XCHG
	DCR	D		;GIVES FROM IN D&E
	LHLD	BUFADPR		;GIVES TO IN H&L
	DCR	H
	XCHG
	MVI	B,0		;MOVE 256 BYTES
	CALL 	QMOVE
	LHLD	BUFPTR
	MOV 	A,H
	XCHG	
	LXI	H,IOBSIZE+1
	SUB	M
	MOV	D,A		
	XCHG
	SHLD	BUFPTR		;STORE NEW BUFFER POINTER ADDRESS
;CHANGES TEMP2 (WILL BE POINTER TO NEXT RECORD)
	LDA	TEMP2+1
	LXI	H,IOBSIZE+1
	SUB	M
	STA	TEMP2+1
	RET
;
;   
;READS THE RECORDS
;
READRS:
	LHLD	BUFADPR
	XCHG	
	LDA	IOBSIZE+1
	RLC			;TIMES TWO
	MOV	B,A		;COUNTER
	LXI	H,80H
LOOP1:
	PUSH H! PUSH B! PUSH D
	CALL	SETDMA
	LHLD	FCBPTR
	XCHG
	CALL	READR
	POP D! POP B! POP H
	ORI	0
	JZ	CONT3
	XCHG			;PUTS BUFFER IN H&L
	MVI	B,80H		;READ TO EOF, NOW PUT 128 1A'S INTO MEMORY
	MVI	A,1AH
LOOP2:
	MOV	M,A
	DCR	B
	JNZ	LOOP2
	JMP	FINIS1
CONT3:
	DCR	B
	JZ	FINIS1
	XCHG			;PUTS 80 IN D&E
	DAD	D
	XCHG			;PUTS ADDRESS IN D&E, 80 IN H&L
	JMP	LOOP1
FINIS1	RET
SETUP:
	LHLD	NEXTAV
	INR	H
	SHLD	BUFADPR		;ADDRESS OF BUFFER
	SHLD	BUFPTR		;INITIALLY SAME AS BUFADPR
	XCHG			;PUTS ADDRESS IN D&E
	LXI	B,33
	LHLD	FCBPTR
	DAD	B		;GIVES ADDRESS OF END OF FCB
	MOV	M,E
	INX	H
	MOV	M,D
	INX	H		;PUT ADDRESS INTO THE FCB STORAGE AREA
	MOV	M,E
	INX	H
	MOV	M,D
	MOV	A,D
	LXI	H,IOBSIZE+1
	ADD	M
	STA	NEXTAV+1
	CALL	READRS
	LXI	H,BUFADPR
	JMP	CONT
SETDMA:
	MVI	C,26
	CALL	BDOS
	RET
READR:
	MVI	C,20
	CALL	BDOS	
	RET
QMOVE:
	MOV	A,M
	STAX	D
	DCR	B		;LENGTH 
	RZ
	INX	H		;FROM ADDRESS
	INX	D		;TO ADDRESS
	JMP	QMOVE
BUFADPR	DB	0,0
BUFPTR	DW	0
FCBPTR	DW	0
TEMP1	DW	0
TEMP2	DW	0
;
;
IOWRITE:
	XCHG
	SHLD	FCBAD
	LHLD	OBPTR
	XCHG			;H&L HAS RECORD PTR., D&E HAD BUFF PTR
	LDA	RECLEN
	MOV	B,A
	CALL	QMOVE		;MOVES RECORD TO BUFFER
	INX	D
	XCHG	
	SHLD	OBPTR		;NEW BUFFER PTR
COMP:
	LHLD	BUFAD
	MVI	A,4
	ADD	H
	MOV	H,A		;BUFFER END
	XCHG			;PUT IN D+E
	LXI	H,OBPTR+1
	MOV	A,D
	CMP	M
	JC	WRIT
	JNZ	CONT4
	DCX	H
	MOV	A,E
	CMP	M
	JZ	WRIT
	JNC	CONT4
WRIT:
	MVI	B,8
	CALL	WRITERS	
	ORI	0
	JNZ	CONT4
	CALL	MOVEB
CONT4:
	RET
;
;
IOCLOSE:
	LHLD	OBPTR
	MVI	A,1AH
	MVI	B,80H
LOOP5:
	MOV	M,A
	DCR	B
	JZ	FINIS5
	INX	H
	JMP	LOOP5
FINIS5:
	MVI	B,8
	CALL	WRITERS
	RET
;
WRITERS:
	LHLD	BUFAD
	XCHG			;PUTS DMA ADDRESS IN D&E
	LXI	H,80H
LOOP4:
	PUSH H! PUSH B! PUSH D
	CALL	SETDMA
	POP D! PUSH D
	XCHG
	MOV	A,M
	CPI	1AH		;EOF?
	JNZ	CONT5
	POP D! POP B! POP H
	JMP	FINIS3
CONT5:
	LHLD	FCBAD
	XCHG
	CALL	WRITER
	POP D! POP B! POP H
	ORI	0
	JNZ	FINIS3		;RETURN IF ERROR
	DCR	B
	JZ	FINIS3
	XCHG			;PUTS 80 IN D&E
	DAD	D
	XCHG			;BUMPS DMA ADDRESS, PUTS BACK IN D&E
	JMP	LOOP4
FINIS3	RET
MOVEB:
	LHLD	BUFAD
	XCHG			;TO ADD IN D&E
	MOV	L,E
	MOV	A,D
	ADI	4
	MOV	H,A		;FROM ADDRESS IN H&L
	MVI	B,0
	CALL	QMOVE		;MOVE 256 BYTES
	LDA	OBPTR+1
	SUI	4
	STA	OBPTR+1
	RET
WRITER:
	MVI	C,21
	CALL	BDOS
	RET
;
;
;
OBPTR	DW	OUTPUTBUFFER	;BUFFER POINTER
FCBAD	DW	0		;ADDRESS OF FCB
;
;
;		M U L T
;
;	THE FOLLOWING RTN IS FROM PAGE 5-12 OF THE INSITE LIBRARY
;	BOOK.  IT IS A 16 BIT MULTIPLY WITH A 16 BIT PRODUCT.
;	THE MULTIPLIER IS IN DE, THE MULTIPLICAND IS IN HL.
;	THE RESULT IS RETURNED IN HL. BC IS UNCHANGED.
;
MULT:
	PUSH	PSW	;SAVE ACCUM AND FLAGS
	PUSH	B	;SAVE REGS B&C
	SHLD	QTEMP	;STORE MULTIPLICAND IN QTEMP
	LXI	H,QNUM	;STORE THE
	MVI	M,11H	;   BIT COUNT
	LXI	B,0000H	;INITIALIZE RESULT
QLOOP:
	MOV	A,D	;ROTATE
	RAR
	MOV	D,A	;  RESULT
	MOV	A,E
	RAR
	MOV	E,A	;     RIGHT
	DCR	M	;DECREMENT BIT COUNT
	JZ	QPOP	;DONE?  THEN  RETURN.
	JNC	QSKIP	;NO CARRY FROM ROTATE
	LHLD	QTEMP	;   OTHERWISE
	DAD	B	;    ADD
	MOV	B,H	;     MULTIPLICAND
	MOV	C,L	;SAVE RESULT
	LXI	H,QNUM	;RESTORE H AND L REGISTERS
QSKIP:
	MOV	A,B	;ROTATE
	RAR		;  QTEMP
	MOV	B,A	;    MULTIPLICAND
	MOV	A,C	;      RIGHT
	RAR
	MOV	C,A
	JMP	QLOOP
QPOP:
	XCHG
	POP	B	;RESTORE REGS
	POP	PSW	;RESTORE STATUS
	RET		;GOBACK
QTEMP	DS	2
QNUM	DS	1
;
;
;		R E A D R E C
;
READREC:
	SHLD	TEMPWORD		;SAVE FCB PTR
	XCHG			;PUT BUF ADDR IN HL
	LXI	D,READRECBUFF	;GET THE ADDR OF THE READ BUFF IN DE
	LDA	INBYTE		;GET LOW ORDER
	MOV	E,A		;PUT IN E
	LDA	RECLEN		;GET LENGTH
	MOV	C,A
	MVI	B,EOFMARK	;CONTROL-Z
;
;HL HOLDS PTR TO LOGICAL BUFFER
;DE HOLDS PTR TO LAST BYTE READ FROM PHYSICAL BUFFER
;C  HOLDS NUMBER OF BYTES IN LOGICAL RECORD
;TEMPWORD HOLDS ADDR OF INPUT FCB
;B  HOLDS EOF MARK
;
READBYTE:
	INR	E		;INCREMENT PTR
	JNZ	SKIPREAD	;IF NOT>FF THEN SKIP PHYSICAL READ
;
;PHYSICAL READ
;
	PUSH	H		;    ENVIRONMENT
	CALL	SETREADDMA
	LHLD	TEMPWORD
	XCHG			;GET FCB PTR
	CALL	READ
	PUSH	PSW			;11/4/77
	CALL	RESETDMA
	POP	PSW			;11/4/77
	CPI	1			;11/4/77
	JNZ	RB1			;11/4/77
	POP	H			;11/4/77
	JMP	EOF1			;11/4/77
;
RB1:					;11/4/77
	POP	H		;RESTORE THE
	LXI	D,READRECBUFF	;RESET PHYSICAL BUFFER PTR
SKIPREAD:
	LDAX	D		;GET A BYTE OF RECORD
	CMP	B		;IS IT AN EOF MARKER---A CONTROL-Z?
	JZ	EOF1		;IF YES GO TO EOF1 RTN
	MOV	M,A		;PUT BYTE INTO RECBUF
	DCR	C		;DECREMENT LENGTH
	JZ	ENDREC		;IF ZERO, RECORD HAS BEEN READ
	INX	H		;INCREMENT DEST PTR
	JMP	READBYTE	;ITERATE
ENDREC:
	MOV	A,E		;GET LAST PHYS BUFFER PTR
	STA	INBYTE		;STORE IT FOR THE NEXT TIME
	XRA	A		;ZERO RETURN CODE
	RET
EOF1:
	MVI	A,01H		;LOAD EOF FLAG
	RET
;
;
SETREADDMA:
	LXI	D,READRECBUFF		;GET ADDR OF BUFFER
	CALL	SETDMAAD
	RET
;
RESETDMA:
	PUSH D!PUSH H!PUSH B
	LXI	D,TBUFF
	CALL	SETDMAAD
	POP B!POP H!POP D
	RET
;
;
;
;		W R I T E R E C
;
WRITEREC:
	SHLD	TEMPWORD		;SAVE FCB PTR
	XCHG			;PUT BUF ADDR IN HL
	MVI	D,00H
	LDA	OUTBYTE
	MOV	E,A
	LDA	RECLEN
	MOV	C,A
;
;HL HOLDS PTR TO LOGICAL RECORD BUFFER
;DE HOLDS PTR TO LAST BYTE WRITTEN INTO PHYSICAL BUFFER
;C  HOLDS NUMBER OF BYTES IN LOGICAL RECORD
;TEMPWORD HOLDS ADDR OF OUTPUT FCB
;
RITEBYTE:
	INR	E		;INCREMENT PTR
	JNZ	SKIPRITE	;IF NOT>FF THEN SKIP PHYSICAL WRITE
;
;PHYSICAL WRITE
;
	PUSH	H		;    ENVIRONMENT
	LHLD	TEMPWORD	;GET FCB ADDR
	XCHG
	CALL	WRITE
	POP	H		;RESTORE THE 
	LXI	D,TBUFF		;RESET PHYSICAL BUFFER PTR
SKIPRITE:
	MOV	A,M		;GET BYTE FROM LOG CAL BUFFER
	STAX	D		;PUT BYTE IN PHYSICAL BUFFER
	DCR	C		;DECREMENT LENGTH
	JZ	END1		;IF ZERO RECORD HAS BEEN WRITTEN
	INX	H		;INCREMENT SOURCE PTR
	JMP	RITEBYTE	;ITERATE
END1:
	MOV	A,E
	STA	OUTBYTE		;SAVE PHYSICAL BUFFER PTR
	RET
;
;
CLEARFIL:
	CALL	RESETDMA
	LDA	WRKDRIVE	;GET WORK DRIVE NR
	CALL	SELECT		;SELECT THE PROPER DRIVE
	LXI	H,FIRSTAV
	SHLD	NEXTAV
	MVI	A,00H
	STA	ERACNT
	LHLD	SEEKADR
	XCHG
	CALL	SEARCHFIRST
	CPI	0FFH		;ANY FILES OUT THERE?
	RZ			;EXIT IF NO MATCH
SAVEFCB:
	ANI	03H
	RAL
	RAL
	RAL
	RAL
	RAL
	MOV	E,A
	MVI	D,00H
	LXI	H,TBUFF
	DAD	D
;
;HL POINTS TO FCB OF FILE TO BE ERASED 
;
	XCHG
	LHLD	NEXTAV
	XCHG
	MVI	C,32D
	CALL	MOVEIT
	XCHG				;SAVE ADDR OF PLACE TO STORE NEXT FCB
	SHLD	NEXTAV
	LXI	H,ERACNT
	INR	M
	LXI	D,SEEKFCB
	CALL	SEARCHNEXT
	CPI	0FFH
	JNZ	SAVEFCB
ERASE:
	LXI	D,0FFE0H	;TWOS COMPLEMENT OF 32D
	LHLD	NEXTAV
	DAD	D
	SHLD	NEXTAV
;
;HL POINTS TO ERASE FCB
;
	XCHG
	CALL	DELETE
	LXI	H,ERACNT
	DCR	M
	JNZ	ERASE		;THERE ARE MORE TO ERASE
	RET
;
;		S  E  L  E  C  T
;
;	ACCUMULATOR HOLDS DRIVE SPECIFIED
;		00=CURRENTLY LOGGED DISK
;		01=DRIVE 'A'
;		02=DRIVE 'B'
;
SELECT:
	CPI	0		;IS REQUEST FOR CURRENTLY LOGGED?
	JNZ	SEL1		;SKIP IT IF NOT
	LDA	CURLOGDRIVE	;IF YES, THEN USE CURLOGDRIVE INSTEAD OF 00H
SEL1:
	DCR	A		;SUBTRACT ONE FROM DRIVE REQUEST
	MOV	E,A		;PUT IT IN LOW ORDER
	MVI	D,00H		;ZERO HIGH ORDER
	MVI	C,14D		;SELECT DRIVE
	PUSH H!PUSH D!PUSH B
	CALL	BDOS		;CALL BDOS
	POP B!POP D!POP H
	RET
;
;
;
;		B  A  C  K  U  P
;
;
BACKUP:
	PUSH	D		;SAVE FCB PTR
	XRA	A		;GET ZEROS SO AS NOT TO CONFUSE CP/M
	STA	OUTFCB		;STORE IN 1ST BYTE OF FCB
	LDA	DRIVEOUT	;GET OUTPUT DRIVE
	CALL	SELECT		;SELECT IT
	POP	D		;RESTORE FCB PTR
	LDA	BACKUPFLAG	;1=BACKUP, 0=NO BACKUP
	ORA	A		;TEST ACCUM
	JZ	DONTBACKUP
	PUSH	D		;SAVE FCB PTR
;
;ERASE BACKUP FILE
;
	CALL	SETTYPEBAK	;MAKE TYPE 'BAK'
	POP	D		;RESTORE FCB PTR
	PUSH	D		;SAVE FCB PTR
	CALL	DELETE		;ERASE ANY BAKUP FILES IF PRESENT
	POP	D		;RESTORE FCB PTR
;
;RENAME CURRENT REAL TYPE TO 'BAK'
;
	PUSH	D		;SAVE IT AGAIN
	XCHG			;PUT FCB PTR IN HL
	LXI	D,DELFCB	;GET ADDR OF WORKING FCB
	MVI	C,9D		;LEN(DRIVE+FILENAME)=9
	CALL	MOVEIT		;PUT IN WORKING FCB
	LXI	D,DELFCB
	CALL	SETTYPE		;SET THE TYPE TO OUTPUT FILE TYPE
	LXI	H,DELFCB
	LXI	D,16D		;SECOND NAME GOES IN SECOND 16 BYTES
	DAD	D		;HL POINTS TO SECOND NAME AREA
	XCHG			;PUT IN DE
	PUSH	D		;SAVE IT
	LXI	H,DELFCB	;GET ADDR OF FIRST NAME
	MVI	C,9D		;MOVE NAME TO SECOND NAME FLD
	CALL	MOVEIT		;
	POP	D		;RESTORE PTR TO SECOND FLD
	CALL	SETTYPEBAK	;MAKE SECOND TYPE = 'BAK'
	LXI	D,DELFCB	;GET ADDR OF WORKING FCB
	CALL	RENAME		;CHANGE IT
	POP	D
	CALL	TEMPTOTYPE	;MAKE '$$$' INTO REAL TYPE FILE
	LXI	D,MSG5		;GET BACKUP MESSAGE
	CALL	STATUSMSGPRT
	RET
;
TEMPTOTYPE:			;CHANGE TEMPFILE TO TYPE
	PUSH	D		;SAVE FCB PTR
	XCHG			;PUT IT IN HL
	LXI	D,DELFCB
	MVI	C,9D
	CALL	MOVEIT		;PUT FILE NAME IN WORKING FCB
	LXI	D,DELFCB
	CALL	SETTYPETEMP	;MAKE TYPE= '$$$'
	LXI	H,DELFCB
	LXI	D,16D		;SECOND NAME IN FCB+16
	DAD	D
	XCHG			;PUT PTR TO SECOND NAME IN DE
	PUSH	D		;SAVE PTR TO FLD 2
	LXI	H,DELFCB
	MVI	C,9D
	CALL	MOVEIT		;MAKE SECOND NAME=FIRST
	POP	D		;RESTORE PTR TO SECOND FLD
	CALL	SETTYPE		;CHANGE '$$$' TO REAL TYPE
	LXI	D,DELFCB	;GET ADDR OF FCB
	CALL	RENAME
	POP	D		;RESTORE FCB PTR OF OUTPUT FILE
	CALL	SETTYPE		;SET OUTPUT FCB TYPE TO REAL TYPE
	RET
;
DONTBACKUP:			;OVERRIDE FLAG IS SET
	PUSH	D		;SAVE OUTPUT FCB PTR
	LXI	H,DELFCB	;GET ADDR OF WORKING FCB
	XCHG			;PUT IN DE
	MVI	C,9D
	CALL	MOVEIT		;PUT FILENAME IN FCB
	LXI	D,DELFCB	;GET ADDR
	CALL	SETTYPE		;MAKE THE TYPE = REAL
	LXI	D,DELFCB
	CALL	DELETE		;ERASE OLD VERSION OF OUTPUT FILE
	POP	D		;RESTORE OUTPUT FILE FCB PTR
	CALL	TEMPTOTYPE	;MAKE '$$$' INTO REAL TYPE
	RET
;
;
MAKETYPES:
	LXI	D,TYPE		;GET ADDR OF REAL TYPE STORAGE AREA
	LXI	H,FT2		;GET ADDR OF OUTPUT FILE TYPE
	MVI	C,3D		;3 CHARS LONG
	CALL	MOVEIT		;MOVE THEM
	RET
;
;
SETTYPE:
	LXI	H,9D
	DAD	D
	LXI	D,TYPE
	XCHG
	MVI	C,3
	CALL	MOVEIT
	RET
;
SETTYPEBAK:
	LXI	H,9D
	DAD	D
	LXI	D,BAK
	XCHG
	MVI	C,3
	CALL	MOVEIT
	RET
;
SETTYPETEMP:
	LXI	H,9D
	DAD	D
	LXI	D,TEMPTYPE
	XCHG
	MVI	C,3
	CALL	MOVEIT
	RET
;
SETTYPESRT:
	LXI	H,9D
	DAD	D
	LXI	D,SORTTYPE
	XCHG
	MVI	C,3
	CALL	MOVEIT
	RET
;
;
;
;		E	O	J
;
;
EOJ:
	LXI	D,OUTFCB	;GET ADDR OF OUTPUT FILE FCB
	CALL	BACKUP		;BACKUP THE FILE
	LDA	MERGEFLG	;GET MERGE FLAG
	ORA	A		;WAS MERGE DONE?
	CNZ	CLEARFIL	;IF YES, ERASE ALL WORKFILES
	LDA	INFOFLG		;GET CONSOLE CHITCHAT FLAG
	CPI	00H		;IS IT A ZERO?
	JZ	REBOOT		;IF YES, THEN DON'T PRINT ANYTHING
	LHLD	TOTIN
	XCHG
	LXI	H,MSG8A
	CALL	BINASC
	LXI	D,MSG8
	CALL	PRTMSG
;
	LDA	WORKCNT
	MOV	E,A
	MVI	D,00H
	LXI	H,MSG7A
	CALL	BINASC
	LXI	D,MSG7
	CALL	PRTMSG
;
	LHLD	TOTOUT
	XCHG
	LXI	H,MSG9A
	CALL	BINASC
	LXI	D,MSG9
	CALL	PRTMSG
;
	LHLD	BSIZE
	XCHG
	LXI	H,MSG10A
	CALL	BINASC
	LXI	D,MSG10
	CALL	PRTMSG
;
	LDA	RECLEN
	MOV	E,A
	MVI	D,00H
	LXI	H,MSG11A
	CALL	BINASC
	LXI	D,MSG11
	CALL	PRTMSG
;
	LDA	NOKEYS
	MOV	E,A
	MVI	D,00H
	LXI	H,MSG12A
	CALL	BINASC
	LXI	D,MSG12
	CALL	PRTMSG
;
REBOOT:
	CALL	CRLF
	LXI	D,EOJMSG	;EOJ MSG
	CALL	PRTMSG
	JMP	BOOT		;GOODBYE!!
;
;
;
CLOSEIT:
	SHLD	TEMPWORD		;SAVE FCB PTR
	MVI	D,00H
	LDA	OUTBYTE
	MOV	E,A
	INR	E
	JZ	RITELAST			;11/4/77
	MVI	A,EOFMARK	;CONTROL-Z
PADLOOP:
	STAX	D
	INR	E
	JNZ	PADLOOP
RITELAST:					;11/4/77
	CALL	RITE1
	LHLD	TEMPWORD
	XCHG
	CALL	CLOSE
	CALL	ZEROFCB		;ZERO THE FCB
	MVI	A,07FH
	STA	OUTBYTE		;RESET OUTPUT BUFFER POINTER
	RET
;
ZEROFCB:
	LHLD	TEMPWORD
	LXI	D,12D
	DAD	D
	MVI	B,21D			;PUT IN 21 ZEROS
	XRA	A
ZF1:
	MOV	M,A
	INX	H
	DCR	B
	JNZ	ZF1
	RET
;
;
RITE1:
	LHLD	TEMPWORD
	XCHG
	CALL	WRITE
	RET
;
PARAMERR:	LXI	D,EMSG1
		JMP	ERRTN
OPENERR:	LXI	D,EMSG2
		JMP	ERRTN
CLOSERR:	LXI	D,EMSG3
		JMP	ERRTN
MAKERR:		LXI	D,EMSG4
		JMP	ERRTN
OVERFLOWERR:	LXI	D,EMSG5
		JMP	ERRTN
WRITERR2:	LXI	D,EMSG7
		JMP	ERRTN
WRITERR3:	LXI	D,EMSG9
		JMP	ERRTN
WRITERR1:	LXI	D,EMSG8
		JMP	ERRTN
READERR:	LXI	D,EMSG11
		JMP	ERRTN
ERRTN:
	CALL	PRTMSG
	JMP	BOOT
;
;
;
;
;
PARAM:
NOTUSED		DS	1
DRIVEIN		DS	1
FN1		DS	8
FT1		DS	3
DRIVEOUT	DS	1
FN2		DS	8
FT2		DS	3
NOTUSED1 	DS	1
RECLEN		DS	1
NOTUSED2 	DS	5
BACKUPFLAG	DS	1
DCHANGE		DS	1
INFOFLG		DS	1
WRKDRIVE 	DS	1
KEYDATA 	DS	20D		;5 KEYS * 4 BYTES EACH
NOTUSED3 	DS	8
;
;
CURLOGDRIVE	DB	00		;DRIVE CURRENTLY LOGGED AT PRGM START
FCBLEN		EQU	37D		;LENGTH OF EACH FCB
MAXWORKFILES	EQU	20D		;MAXIMUM NUMBER OF WORK FILES
KEYSIZE		EQU	4D		;NUMBER OF BYTES IN EACH KEY SPECIFICATION FIELD
SORTTYPE	DB	'SRT'		;TYPE FIELD FOR SORT PARAM FILE
TYPE		DB	'   '		;HOLDING AREA FOR OUTPUT FILE TYPE
TEMPTYPE	DB	'$$$'		;TYPE FIELD FOR TEMPORARY FILES
BAK		DB	'BAK'		;TYPE FIELD FOR BACKUP FILES
BSIZE		DS	2		;HOLDS BUFFERSIZE FOR PRINTED STATS
CRECCNT		DW	0		;TWOS COMP OF RECCNT
ERACNT		DB	0		;NUMBER OF FILES TO BE ERASED
BOOT		EQU	0000H		;BOOT ADDR
MAXKEYS		DB	05D		;MAXIMUM NUMBER OF KEYS ALLOWED
MASK		DS	1		;STORAGE AREA FOR MASK BYTE
EOFMARK		EQU	1AH		;END OF FILE MARKER
INBYTE		DB	0FFH		;LOW ORDER BUFFER PTR FOR READ
OUTBYTE 	DB	7FH		;LOW ORDER BUFFER PTR FOR WRITE
HEAPFLG 	DB	0		;INFORMS SORT1 THAT IT IS HEAPING
HEAPLEN 	DB	4D		;LENGTH OF EACH ELEMENT IN HEAP
HEAPCNT		DB	0		;NUMBER OF ENTRIES (FILES) IN HEAP
IOBSIZE		DW	0		;HOLDS SIZE OF WORKFILE BUFFERS
NODE		DS	1		;HEAP PTR OF CURRENT NODE
CHILD1		DS	1		;HEAP PTR OF FIRST CHILD OF NODE
CHILD2		DS	1		;HEAP PTR OF SECOND CHILD OF NODE
SMALLEST 	DS	1		;HEAP PTR OF SMALLEST CHILD OF NODE
LIMIT		DS	2		;TWOS COMPLEMENT OF NUMBER OF
					;RECORDS THAT FIT IN SORT BUFFER
TBUFF		EQU	0080H		;ADDR OF DEFAULT I/O BUFFER
TFCB		EQU	005CH		;ADDR OF DEFAULT FCB MADE BY CPM
BDOS		EQU	0005H		;ENTRY TO CP/M IO FACILITIES
HEAPBOTM:				;RECBUF IS USED AS HEAPING AREA
RECBUF		DS	256D		;LOGICAL RECORD IO BUFFER
EOFFLG		DB	0		;END OF FILE FLAG FOR INFCB
MERGEFLG 	DB	0		;IS A MERGE NECESSARY?
NEXTAV		DW	0		;HOLDS PTR TO NEXT SPACE IN BUFFER
RECCNT		DW	0		;HOLDS NUMBER OF RECORD IN BUFFER
ENDFLG		DB	0		;BUFFER FULL FLAG
CURBYTE 	DB	0		;CURRENT BYTE COMPARED IN COMPKEY
WORKCNT		DB	0		;HOLDS NUMBER OF OPENED WORK FILES
BUFAD		DW	OUTPUTBUFFER	;HOLDS ADDR OF OUTPUT BUFFER AREA
NEXTFCB		DW	WORKFCBS	;HOLDS ADDR OF WORKFILE FCBS
CURFCB		DW	0		;HOLDS PTR TO CURRENT WORKFILE FCB
OUTCNT		DW	0		;NUMBER OF LOGICAL RECS WRITTEN TO CUR WORKFILE
TOTIN		DW	0		;TOTAL NUMBER OF RECORDS READ
TOTOUT		DW	0		;TOTAL NUMBER OF RECORDS WRITTEN
NOKEYS		DB	0		;NUMBER OF SORT KEY FIELDS
MI		DW	0		;INDEX
K		DW	0		;INDEX
J		DW	0		;INDEX
LI		DW	0		;RELATIVE RECORD NUMBER
I		DW	0		;RELATIVE RECORD NUMBER
KEYLEN		DB	0		;LENGTH IN BYTES OF CURRENT KEY
CURKEY		DB	0		;NUMBER OF CURRENTLY COMPARED KEY
CURPARM 	DW	0		;HOLDS PTR TO CURRENT 3 BYTE PARM STRING
REC1		DW	0		;PTR TO ELEMENT(REC1)
REC2		DW	0		;PTR TO ELEMENT(REC2)
SWAPFLAG 	DB	0		;IS AN EXCHANGE NECESSARY?
ZEROFLAG 	DB	0		;NON ZERO RESULT FROM COMPARE
TEMPWORD 	DW	0		;TEMPORARY STORAGE
SEEKADR		DW	SEEKFCB
;
SORTINGMSG	DB	' SORTING$'
MSG3		DB	' JUST OPENED: '
MSG3A		DB	'              %'	;OUTPUT WITH PCHAR, STOPPED BY '%'
MERGINGMSG	DB	' MERGING$'
MSG5		DB	' OUTPUT FILE BACKED UP$'
EOJMSG		DB	'SORT COMPLETED$'
MSG7		DB	' WORKFILES USED:             '
MSG7A:		DB	'     $'
MSG8		DB	' INPUT RECORDS READ:         '
MSG8A:		DB	'     $'
MSG9		DB	' OUTPUT RECORDS WRITTEN:     '
MSG9A:		DB	'     $'
MSG10		DB	' BYTES IN BUFFER:            '
MSG10A:		DB	'     $'
MSG11		DB	' BYTES PER LOGICAL RECORD:   '
MSG11A:		DB	'     $'
MSG12		DB	' KEYS SPECIFIED:             '
MSG12A:		DB	'     $'
LOADINGMSG	DB	' LOADING$'
CHANGEMSG	DB	' PLACE DESIRED OUTPUT DISKETTE ON DRIVE '
CHANGEMSGA	DB	'  THEN TYPE RETURN$'
;
;
EMSG1	DB	'QS01   MISSING OR INVALID SORT PARAMETERS$'
EMSG2	DB	'QS02	OPEN ERROR$'
EMSG3	DB	'QS03   CLOSE ERROR$'
EMSG4	DB	'QS04	NO DIR SPACE$'
EMSG5	DB	'QS05	INPUT TOO LARGE$'
EMSG6	DB	'QS06   $'
EMSG7	DB	'QS07	OUT OF DISK SPACE$'
EMSG8	DB	'QS08   FILE ERROR$'
EMSG9	DB	'QS09   NO DIR SPACE$'
EMSG10	DB	'QS10   $'
EMSG11	DB	'QS11	READ ERROR$'
;
;
INFCB	DB	0		;NOT USED
	DS	11D
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
OUTFCB	DB	0		;NOT USED
	DS	11D
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
SEEKFCB	DB	0		;NOT USED
	DB	'SRTWRK??$$$'
	DB	'?',0			;ERASE ALL EXTENTS
	DW	0,0,0,0,0,0,0,0,0
	DB	0
DELFCB	DB	0		;NOT USED
	DS	11D
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0
;
;
WORKFCBS:
WRKFCB0	DB	0		;NOT USED
	DB	'SRTWRK00$$$'
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
WRKFCB1	DB	0		;NOT USED
	DB	'SRTWRK01$$$'
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
WRKFCB2	DB	0		;NOT USED
	DB	'SRTWRK02$$$'
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
WRKFCB3	DB	0		;NOT USED
	DB	'SRTWRK03$$$'
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
WRKFCB4	DB	0		;NOT USED
	DB	'SRTWRK04$$$'
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
WRKFCB5	DB	0		;NOT USED
	DB	'SRTWRK05$$$'
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
WRKFCB6	DB	0		;NOT USED
	DB	'SRTWRK06$$$'
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
WRKFCB7	DB	0		;NOT USED
	DB	'SRTWRK07$$$'
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
WRKFCB8	DB	0		;NOT USED
	DB	'SRTWRK08$$$'
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
WRKFCB9	DB	0		;NOT USED
	DB	'SRTWRK09$$$'
	DW	0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0
WRKFCB10	DB	0		;NOT USED
		DB	'SRTWRK10$$$'
		DW	0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0
WRKFCB11	DB	0		;NOT USED
		DB	'SRTWRK11$$$'
		DW	0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0
WRKFCB12	DB	0		;NOT USED
		DB	'SRTWRK12$$$'
		DW	0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0
WRKFCB13	DB	0		;NOT USED
		DB	'SRTWRK13$$$'
		DW	0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0
WRKFCB14	DB	0		;NOT USED
		DB	'SRTWRK14$$$'
		DW	0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0
WRKFCB15	DB	0		;NOT USED
		DB	'SRTWRK15$$$'
		DW	0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0
WRKFCB16	DB	0		;NOT USED
		DB	'SRTWRK16$$$'
		DW	0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0
WRKFCB17	DB	0		;NOT USED
		DB	'SRTWRK17$$$'
		DW	0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0
WRKFCB18	DB	0		;NOT USED
		DB	'SRTWRK18$$$'
		DW	0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0
WRKFCB19	DB	0		;NOT USED
		DB	'SRTWRK19$$$'
		DW	0,0,0,0,0,0,0,0,0,0
		DB	0,0,0,0,0
;50D BYTE STACK AREA:
	DW	0FFFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH
	DW	0FFFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH
	DW	0FFFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH
	DW	0FFFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH
	DW	0FFFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH
NEWSTACK:
DUMPAID	DB	'<--STACK'
FIRSTAV:
STARTIOB:
OUTPUTBUFFER	DS	500H		;OUTPUT BUFFER FOR MERGE I/O RTNS
ENDIOB: