; mails/asm - kjw/bqsd - version 2.00 - 01/83
;
; revised 02/23/83 - kjw
;
	TITLE	'<PowerMAIL - 2.00 source code>'
;
;	system data usage
;
;	+1	7 - 1 = data record in memory
;		6 - 1 = index record in memory
;		3 - 1 = purge duplicates
;		2-0   = drive # for temp files
;	+7,8,9		- logical data record #
;	+10,11,12	- physical data record #
;	+13		- data offset in buffer
;	+14,15,16	- # records remaining
;	+17,18,19	- # records deleted this file
;	+20,21,22	- total # records deleted
;	+23,24,25	- # records loaded into memory
;	+26		- current temp file #
;	+27,28,29	- work for file positioning
;	+30		- length of index record
;
*GET	MAILEQU			;system equates
*GET	MAILDISK		;I/O drivers
;
	ORG	CODE
*GET	MAILDVRS		;I/O drivers
*GET	MAILMATH		;math subs
;
	SUBTTL	'<mails/asm - SORT module>'
;
	PAGE
;
ENTRY	LD	IY,SYSTEM	;reset system pointer
	CALL	INTEG		;check memory integrety
	LD	A,(IY+31)	;get id flag
	CP	'*'		;initialized?
	JP	NZ,CORRUPT	;go if not!
;
	LD	L,(IY+2)	;fetch stack pointer
	LD	H,(IY+3)	;HL = init stack
	LD	SP,HL		;reset it
;
;	relocate sort definition table
;
	LD	L,(IY+22)	;get current table addres
	LD	H,(IY+23)
	LD	DE,SRTTBL0	;sort table
	LD	BC,24		;table length
	LDIR			;move it down!
;
;	check if single sort field + no purge
;
	RES	0,(IY+0)	;reset quick-sort
	LD	A,(SRTTBL0+1)	;get second entry
	INC	A		;terminator?
	JR	NZ,NOQSRT	;no quick sort!
;
	BIT	3,(IY+0)	;purge on?
	JR	NZ,NOQSRT	;yes, no quick sort
	SET	0,(IY+0)	;set quick-sort
;
;	calculate length of each entry
;
NOQSRT	LD	HL,SRTTBL	;sort table
	LD	BC,0A00H	;B=looper, C=counter
CNTSRT	LD	A,(HL)		;get entry
	INC	A		;terminator?
	JR	Z,CNTSRTD	;done, go!
	INC	HL		;bump pointer
	LD	A,(HL)		;get length byte
	ADD	A,C		;add to total
	LD	C,A		;update
	INC	HL		;next record
	DJNZ	CNTSRT		;go for table length
;
CNTSRTD	LD	A,C		;get subtotal
	ADD	A,3		;record # length
	LD	(IY+30),A	;save index length
;
;	init sort parameters
;
	LD	A,(IY+21)	;get dest drive
	INC	A		;global?
	JR	NZ,SETSDRV	;nope, set temp drive
;
;	global on temp sort files
;
	LD	A,ETX		;end of text
	LD	(FILETB-1),A	;to filespec
	JR	SETSDRW		;continue
;
SETSDRV	DEC	A		;adjust drive # back
	ADD	A,'0'		;make it ascii
	LD	(FILETB),A	;to the string
	LD	A,':'		;drive specifier
	LD	(FILETB-1),A	;to the string
;
SETSDRW	LD	BC,0800H	;B=counter, C=drive
	LD	(IY+20),C	;init total deleted
	LD	(IY+21),C
	LD	(IY+22),C
;
SORTXLP	PUSH	BC		;save BC
	LD	A,C		;get drive #
	CALL	LOCFCB		;locate the FCB
	BIT	7,(IX+0)	;file open?
	CALL	NZ,SORTIT	;sort the file!
	CALL	NZ,SERROR	;sort error!
	POP	BC		;restore count
	INC	C		;bump drive #
	DJNZ	SORTXLP		;go for 8 drives
;
;	display # records deleted total
;
	LD	B,(IY+20)	;MSB
	LD	H,(IY+21)
	LD	L,(IY+22)
	LD	DE,MSGS1A	;text
	CALL	BINASC		;binary => ascii
	LD	HL,MSGS1	;sort complete!
	CALL	DISPLAY		;display message
	CALL	INKEY		;wait for a key
	JP	EXIT		;exit to utilities
;
;	sort current file
;
SORTIT	LD	A,(IX+10)	;get # records used
	OR	(IX+11)
	OR	(IX+12)		;nil file?
	RET	Z		;yes, return!
;
	XOR	A		;load zero
	LD	(IY+7),A	;current data record
	LD	(IY+8),A
	LD	(IY+9),A
	LD	(IY+17),A	;set # records deleted
	LD	(IY+18),A
	LD	(IY+19),A
	LD	(IY+26),A	;set current temp file
	RES	7,(IY+1)	;set no data in buffer
	LD	A,(IX+10)	;get # records used
	LD	(IY+14),A	;save as # remaining
	LD	A,(IX+11)
	LD	(IY+15),A
	LD	A,(IX+12)
	LD	(IY+16),A
;
;	check if file already sorted by a similar fashion
;
	BIT	3,(IY+0)	;purge on?
	JR	NZ,SORTER	;go if yes!
	BIT	6,(IX+0)	;file sorted?
	JR	Z,SORTER	;go if not sorted!
	BIT	2,(IY+0)	;forced sort on?
	JR	NZ,SORTER	;go if yes!
	LD	A,(SRTTBL0)	;get primary sort field
	CP	(IX+13)		;same?
	JR	NZ,SORTER	;go if not same!
	LD	A,(SRTTBL0+1)	;get secondary field
	INC	A		;nil?
	RET	Z		;yes, don't bother sort!
	DEC	A		;put it back
	SUB	(IX+14)		;same?
	RET	Z		;yes, return!
;
SORTER	LD	A,(IX+0)	;drive #
	AND	7		;low 3 bits
	ADD	A,'0'		;ascii drive #
	LD	(MSGS2A),A	;to message
	LD	HL,MSGS2	;'sorting drive x:'
	CALL	DISPLAY		;display message
	LD	HL,0		;load zero
	LD	(RECMEM),HL	;# records in memory
	LD	HL,MSGS6	;'loading'
	CALL	DISPLAY		;display message
	LD	HL,BUFFER	;start memory buffer
	LD	(POSIT),HL	;save position
;
SORTLP	CALL	LOADREC		;load record
	RET	NZ		;go on disk error!
	LD	HL,$		;get recs in memory
RECMEM	EQU	$-2
	INC	HL		;bump it
	LD	(RECMEM),HL	;update
	LD	B,(IY+7)	;get data record
	LD	H,(IY+8)
	LD	L,(IY+9)
	CALL	INCBHL		;increment record #
	LD	(IY+7),B	;update
	LD	(IY+8),H
	LD	(IY+9),L
	LD	B,(IY+14)	;get # records remaining
	LD	H,(IY+15)
	LD	L,(IY+16)
	CALL	DECBHL		;decrement
	LD	(IY+14),B	;update
	LD	(IY+15),H
	LD	(IY+16),L
	LD	A,B		;check if done
	OR	H
	OR	L		;BHL = 000000?
	JR	Z,DONREAD	;yes, done loading!
	CALL	IFTOP		;buffer at topmem?
	JR	NC,SORTLP	;go if more room
	LD	HL,MSGS3	;'sorting'
	CALL	DISPLAY		;display
	CALL	SORTMEM		;sort memory buffer
	LD	HL,MSGS7	;saving temporary file
	CALL	DISPLAY		;display message
	CALL	SAVETMP		;save temp file
	RET	NZ		;go on error!
	JP	SORTER		;continue
;
DONREAD	LD	A,(IY+26)	;get # temp files
	OR	A		;any?
	JP	NZ,MERGEM	;merge the files!
	LD	HL,MSGS3	;'sorting'
	CALL	DISPLAY		;display message
	CALL	SORTMEM		;sort memory buffer
	LD	HL,MSGS4	;'writing index'
	CALL	DISPLAY		;display message
	RES	6,(IX+0)	;set NOT sorted
	CALL	WRITIND		;write index file!
	RET	NZ		;go if error!
;
;	display # records deleted
;
SORTCMP	SET	6,(IX+0)	;set SORTED
	LD	A,(SRTTBL0)	;get primary field
	LD	(IX+13),A	;to file block
	LD	A,(SRTTBL0+1)	;get secondary field
	LD	(IX+14),A	;to file block
	LD	B,(IY+17)	;get # deleted
	LD	H,(IY+18)
	LD	L,(IY+19)
	LD	DE,MSGS5A	;text
	CALL	BINASC		;binary => ascii
	LD	HL,MSGS5	;start of message
	CALL	DISPLAY		;display it
	CALL	INKEY		;wait for a key
	XOR	A		;return no errors
	RET			;on to next drive
;
;	merge sorted temporary files
;
MERGEM	LD	HL,MSGS3	;'sorting'
	CALL	DISPLAY		;display
	CALL	SORTMEM		;sort memory buffer
	LD	HL,MSGS7	;'saving temp file'
	CALL	DISPLAY		;display message
	CALL	SAVETMP		;saving temporary file
	RET	NZ		;go on error
	LD	HL,MSGS8	;merging temp files
	CALL	DISPLAY		;display
	CALL	MERGE		;merge the files
	RET	NZ		;go on error
	JR	SORTCMP		;complete, go!
;
	SUBTTL	'<mails/asm - subroutines>'
;
	PAGE
;
;	clear out I/O buffer
;
ZBUFF	PUSH	HL		;save all
	PUSH	DE
	PUSH	BC
	LD	D,H		;pass to DE
	LD	E,L
	INC	DE		;DE = start +1
	LD	BC,0FFH		;length -1
	LD	(HL),0		;load one zero
	LDIR			;load all zeroes
	POP	BC		;unstack
	POP	DE
	POP	HL
	RET			;buffer cleared to 0's
;
;	open temporary files for sort/merge
;
OPENEM	LD	B,(IY+27)	;get # temp files
	LD	IX,BUFFER	;start free memory
	LD	DE,BUFFER+400H	;allow room for table
	LD	C,1		;file #
;
OPENLP	PUSH	BC		;save
	CALL	OPENIT		;open the file
	POP	BC		;restore
	RET	NZ		;go if error!
	LD	(POSIT),DE	;save mem posit
	CALL	IFTOP		;any more memory?
	JR	C,MEMOUT	;out of memory?
	INC	C		;bump file
	PUSH	DE		;save it
	LD	DE,8		;8 bytes / entry
	ADD	IX,DE		;IX => next entry
	POP	DE		;restore
	DJNZ	OPENLP		;finish all files
;
OUTMEM	LD	(POSIT),DE	;new free mem buffer
	XOR	A		;return Z
	RET			;done!
;
MEMOUT	DEC	B		;at last record?
	JR	Z,OUTMEM	;yes, continue
	LD	A,35		;memory error
	OR	A		;set NZ
	RET			;return!
;
OPENIT	LD	(IX+0),E	;save DCB
	LD	(IX+1),D
	LD	HL,50		;DCB length
	ADD	HL,DE		;HL => I/O buffer
	LD	(IX+2),L	;save buffer start
	LD	(IX+3),H
	LD	(IX+4),L	;save file position
	LD	(IX+5),H
	LD	A,C		;get drive #
	CALL	ASCII		;make it ascii
	LD	(FILETA),A	;to filename text
	LD	(FILETA+1),BC	;rest of ascii
	PUSH	DE		;save DCB
	PUSH	HL		;save I/O buffer
	LD	HL,FILET	;start of filespec
	LD	BC,32		;max filename length
	LDIR			;move name into FCB
	POP	HL		;unstack
	POP	DE		;restore FCB
;
	OPEN$			;open existing file
	RET	NZ		;go if error
	READ$			;read first record
	RET	NZ		;go if error!
;
	LD	L,(IX+2)	;get current I/O buff
	LD	H,(IX+3)
	PUSH	HL		;save on stack
	LD	DE,100H		;buffer length
	ADD	HL,DE		;HL => next block
	EX	DE,HL		;DE => next block
	POP	HL		;restore I/O buffer
	LD	A,(HL)		;get LSB count
	LD	(IX+6),A	;pass it
	INC	HL		;bump pointer
	LD	A,(HL)		;get MSB count
	LD	(IX+7),A	;pass it
	PUSH	DE		;save
	LD	E,(IX+0)	;get FCB address
	LD	D,(IX+1)
;
	READ$			;load I/O buffer
	POP	DE		;restore mem address
	RET			;return with status
;
;	delete record # BHL
;
KILLREC	LD	IX,$		;fetch fcb pointer
PASSIX	EQU	$-2
	CALL	COMPSEC		;divide in half
	LD	(PASSA),A	;save sector offset
	LD	C,(IX+4)	;get start rec data
	LD	D,(IX+5)
	LD	E,(IX+6)
	CALL	ADDIT		;add CDE => BHL
	LD	(IY+23),B	;save record
	LD	(IY+24),H
	LD	(IY+25),L	;BHL = phys sector
	LD	E,(IX+15)	;fetch FCB address
	LD	D,(IX+16)
	LD	(PASSDE),DE	;pass pointer
	LD	BC,SYSTEM+23	;point to record #
;
	POSN$			;position to record
	RET	NZ		;go if error
	READ$			;read the sector
	RET	NZ		;go if error
;
	LD	L,(IX+17)	;get buffer address
	LD	H,(IX+18)
	LD	C,'$'		;get offset
PASSA	EQU	$-1
	LD	B,0		;BC = offset
	ADD	HL,BC		;HL => record
	CALL	DELIT		;delete record
;
	LD	DE,$		;fetch FCB address
PASSDE	EQU	$-2
	LD	BC,SYSTEM+23	;point to rec #
;
	POSN$			;position to record
	RET	NZ		;go if error
	WRITE$			;write the record!
	RET	NZ		;go if error
;
	LD	B,(IY+17)	;get # deleted this file
	LD	H,(IY+18)
	LD	L,(IY+19)
	CALL	INCBHL		;+1
	LD	(IY+17),B	;update
	LD	(IY+18),H
	LD	(IY+19),L
	LD	B,(IY+20)	;get total deleted
	LD	H,(IY+21)
	LD	L,(IY+22)
	CALL	INCBHL		;+1
	LD	(IY+20),B	;update
	LD	(IY+21),H
	LD	(IY+22),L
	XOR	A
	RET			;return now
;
;	delete current record
;
DELIT	LD	DE,14		;offset to end
	ADD	HL,DE		;HL => end
	LD	D,H		;pass to DE
	LD	E,L		;DE => end
	DEC	HL		;HL => end -1
	LD	BC,14		;field length -1
	LDDR			;move it up
	LD	A,-1		;delete flag
	LD	(DE),A		;to buffer
	RET			;done
;
;	merge sorted temporary files
;
MERGE	LD	A,(IY+26)	;get # temp files
	LD	(IY+27),A	;save # files
	PUSH	IX		;save drive address
	CALL	OPENEM		;open all files
	POP	IX		;restore fcb block
	RET	NZ		;go if error!
	LD	HL,BUFFX	;buffer to build with
	LD	(POS),HL	;save position
;
;	position data file to record #1
;
	LD	E,(IX+15)	;get FCB address
	LD	D,(IX+16)
	LD	BC,REWIND	;3 00's
;
	POSN$			;rewind file!
	RET	NZ		;go if error
	READ$			;read first record
	RET	NZ		;go if error
;
NEWCLP	CALL	FETCH		;fetch a record
	RET	NZ		;go if error
	LD	A,(IY+29)	;any records in memory?
	OR	A		;00?
	JR	Z,NEWFL		;yes, done, write last
	CALL	STASH		;write record to buffer
	RET	NZ		;go if error!
	JR	NEWCLP		;continue
;
NEWFL	LD	E,(IX+15)	;get fcb address
	LD	D,(IX+16)
;
	WRITE$			;write last buffer
	RET			;return with status
;
;	write a record to index buffer
;
STASH	LD	DE,$		;get buffer address
POS	EQU	$-2
	LD	A,E		;get LSB
	ADD	A,23		;room for more index?
	JR	NC,STS0		;yes, continue
;
	LD	HL,BUFFX	;X I/O buffer
	LD	E,(IX+17)	;get real I/O buffer
	LD	D,(IX+18)
	LD	BC,100H		;buffer length
	LDIR			;move it in
;
	LD	E,(IX+15)	;get FCB address
	LD	D,(IX+16)
;
	WRITE$			;write buffer
	RET	NZ		;go if error
	LD	DE,BUFFX	;restart buffer
;
STS0	LD	HL,(BASE)	;source data pointer
	LD	BC,(SRTTBL)	;B = primary data length
	LD	C,B		;C = length
	LD	B,0		;BC = length
	LD	A,20		;max length
	SUB	C		;less actual
	LDIR			;move into buffer
	OR	A		;done?
	JR	Z,STS2		;yes, go!
	EX	DE,HL		;HL => buffer
STS1	LD	(HL),' '	;load blank
	INC	HL		;bump buffer
	DEC	A		;less count
	JR	NZ,STS1		;fill it up
	EX	DE,HL		;DE => buffer
STS2	LD	HL,(BASE)	;get data start again
	LD	C,(IY+30)	;offset to next record
	LD	B,0		;BC = offset
	ADD	HL,BC		;HL => next record
	DEC	HL		;-1
	DEC	HL		;-2
	DEC	HL		;-3
	LD	C,3		;record # length
	LDIR			;move in record #
	LD	(POS),DE	;save new buff posit
	XOR	A		;no error
	RET			;done
;
;	load record for merge/sort
;
FETCH	LD	(IY+28),0	;clear current drive
	LD	HL,(POSIT)	;get memory address
	LD	(TEMP),HL	;save position
	LD	(IY+29),0	;set # active files
;
FETLP	INC	(IY+28)		;bump table
	PUSH	IX		;save
	CALL	TEMPREC		;read temp record
	POP	IX		;restore
	RET	NZ		;go if disk error
	LD	DE,(TEMP)	;get mem pointer
	LD	HL,(POSIT)	;get current posit
	PUSH	HL		;save on stack
	LD	(POSIT),DE	;save for topmem test
	CALL	IFTOP		;any more memory?
	POP	HL		;restore
	LD	(POSIT),HL	;reset
	LD	B,-1		;set for error
	JP	C,MEMOUT	;go if no more memory
	LD	A,(IY+28)	;get current drive
	CP	(IY+26)		;at end of sort files?
	JR	C,FETLP		;go if more to check
	LD	A,(IY+29)	;get # active files
	OR	A		;anything?
	RET	Z		;nope, return!
;
	LD	B,A		;pass # to check
	LD	HL,(POSIT)	;get ram posit
	LD	D,H		;pass to DE
	LD	E,L
	LD	(BASE),HL	;save base pointer
	JR	S2		;continue
;
S1	PUSH	IX		;save
	CALL	COMPARE		;compare indexes
	POP	IX		;restore
	JR	NC,S2		;go if not less
	LD	(BASE),DE	;save new base
S2	PUSH	HL		;save pointer
	LD	L,(IY+30)	;get sort offset length
	LD	H,0		;HL = offset
	INC	HL		;+1 for file #
	ADD	HL,DE		;HL => next rec
	EX	DE,HL		;DE => next rec
	POP	HL		;restore start
	DJNZ	S1		;check 'em all
;
	LD	HL,(BASE)	;get base address
	LD	E,(IY+30)	;get offset
	LD	D,0		;DE = offset
	ADD	HL,DE		;HL => end
	LD	A,(HL)		;get file #
	DEC	A		;adjust to actual
	LD	L,A		;pass to L
	LD	H,0		;HL = offset
	ADD	HL,HL		;*2
	ADD	HL,HL		;*4
	ADD	HL,HL		;*8
	PUSH	IX		;save
	LD	IX,BUFFER	;start lookup table
	EX	DE,HL		;DE = offset
	ADD	IX,DE		;IX => entry
	LD	E,(IX+4)	;get buff address
	LD	D,(IX+5)
	LD	L,(IY+30)	;get data offset
	LD	H,0		;HL = offset
	ADD	HL,DE		;HL => next
	LD	(IX+4),L	;update
	LD	(IX+5),H
	LD	L,(IX+6)	;total recs left
	LD	H,(IX+7)
	DEC	HL		;less 1
	LD	(IX+6),L	;update
	LD	(IX+7),H
	POP	IX		;restore
	XOR	A		;return Z
	RET			;done
;
TEMPREC	LD	A,(IY+28)	;get drive counter
	DEC	A		;adjust 0 relative
	LD	L,A		;L = offset
	LD	H,0		;HL = offset
	ADD	HL,HL		;*2
	ADD	HL,HL		;*4
	ADD	HL,HL		;*8
	LD	IX,BUFFER	;start table
	EX	DE,HL		;DE = offset
	ADD	IX,DE		;IX => entry
	LD	A,(IX+6)	;any data?
	OR	(IX+7)
	RET	Z		;go if not
	LD	L,(IX+2)	;get buffer
	LD	H,(IX+3)
	LD	E,(IX+4)	;get current
	LD	D,(IX+5)
	INC	H		;bump buffer
	PUSH	HL		;save on stack
	LD	L,(IY+30)	;get data offset
	LD	H,0		;HL = offset
	ADD	HL,DE		;HL => entry
	EX	DE,HL		;DE => entry
	POP	HL		;restore
	OR	A		;clear carry
	SBC	HL,DE		;data in buffer?
	JR	NC,TPO		;go if yes
;
	LD	E,(IX+0)	;get FCB address
	LD	D,(IX+1)
;
	READ$			;read next record
	RET	NZ		;go if error!
;
	LD	A,(IX+2)	;get buffer
	LD	(IX+4),A	;reset it
	LD	A,(IX+3)
	LD	(IX+5),A
;
TPO	LD	DE,$		;get temp pointer
TEMP	EQU	$-2
	LD	L,(IX+4)	;get I/O buffer
	LD	H,(IX+5)
	LD	C,(IY+30)	;get data length
	LD	B,0		;BC = length
	LDIR			;move into buffer
	LD	A,(IY+28)	;get current file
	LD	(DE),A		;to buffer
	INC	DE		;bump pointer
	LD	(TEMP),DE	;save new pointer
	INC	(IY+29)		;bump # recs in memory
	XOR	A		;load Z
	RET			;return no error
;
;	compute physical sector #
;
COMPSEC	SRL	B		;divide in half
	RR	H
	RR	L
	LD	A,0		;sector offset
	RET	NC		;at 0
	LD	A,80H		;at 80h
	RET
;
;	compare two data blocks
;
COMPARE	PUSH	BC		;save
	PUSH	DE
	PUSH	HL
	LD	(PASSIX),IX	;pass IX for KILL
;
	LD	HL,(BASE)	;get base address
	LD	IX,SRTTBL	;sort table
	LD	C,0		;data offset
;
COMP1	PUSH	DE		;save
	PUSH	HL		;save
	LD	B,0		;BC = offset
	ADD	HL,BC		;add offset
	EX	DE,HL		;swap
	ADD	HL,BC		;add offset
	EX	DE,HL		;swap back
	LD	B,(IX+1)	;get field length
;
COMP2	LD	A,(DE)		;get entry
	CP	(HL)		;equal?
	JR	NZ,COMP3	;go if not
	INC	DE		;bump pointers
	INC	HL
	DJNZ	COMP2		;go for length
;
COMP3	POP	HL		;unstack
	POP	DE
	JR	NZ,COMPRET	;mismatch, return!
	EX	AF,AF'		;save flags
	LD	A,(IX+1)	;get data length
	ADD	A,C		;add to offset
	LD	C,A		;update
	INC	IX		;bump table
	INC	IX
	LD	A,(IX+0)	;get entry
	AND	(IX+1)		;check for FFFF term
	INC	A		;yes?
	JR	NZ,COMP1	;go if not end
	BIT	3,(IY+0)	;purge duplicates?
	JR	NZ,PURGED	;yes, purge it
	EX	AF,AF'		;get flags back
;
COMPRET	POP	HL		;unstack
	POP	DE
	POP	BC
	LD	IX,(PASSIX)	;get IX back
	RET			;return with flags
;
PURGED	POP	HL		;restore
	POP	DE		;DE => record to delete
	PUSH	DE		;back on stack
	PUSH	HL
;
	LD	L,(IY+30)	;get offset length
	LD	H,0		;HL = offset
	ADD	HL,DE		;HL => next record
;
;	delete index portion of record
;
	PUSH	HL		;save rec # pointer
	EX	DE,HL		;HL => index data
	CALL	DELIT		;set as deleted
	POP	HL		;restore rec pointer
;
	DEC	HL		;point to lsb
	LD	E,(HL)		;get it
	DEC	HL		;point to nsb
	LD	D,(HL)		;get it
	DEC	HL		;point to msb
	LD	B,(HL)		;get it
	EX	DE,HL		;BHL = record #
	CALL	KILLREC		;kill record
	XOR	A		;load zero
	JR	COMPRET		;return
;
;	write out index file
;
WRITIND	LD	HL,BUFFER	;start of mem buffer
	LD	(POSIT),HL	;save pointer
	LD	E,(IX+15)	;get fcb pointer
	LD	D,(IX+16)
	LD	B,0		;msb = 0
	LD	H,B		;nsb = 0
	LD	L,1		;lsb = 1
;
	LD	(IY+27),B	;save record #
	LD	(IY+28),H
	LD	(IY+29),L
	LD	BC,SYSTEM+27	;point to data
	POSN$			;position to record
	RET	NZ		;go if error
;
	LD	A,(IX+10)	;get # records used
	LD	(IY+14),A	;init remaining
	LD	A,(IX+11)
	LD	(IY+15),A
	LD	A,(IX+12)
	LD	(IY+16),A
;
WOLP	LD	E,(IX+17)	;get buffer pointer
	LD	D,(IX+18)	;DE => I/O buff
	LD	(IY+13),11	;# records / sector
	LD	HL,(POSIT)	;get memory posit
	EX	DE,HL		;HL => buffer
	CALL	ZBUFF		;clear it out
	EX	DE,HL		;swap back
;
WILP	PUSH	HL		;save mem posit
	LD	A,(SRTTBL+1)	;get field length
	LD	C,A		;pass to C
	LD	B,0		;BC = length
	LDIR			;move in the data
	LD	B,A		;pass length to B
	LD	A,20		;max length
	SUB	B		;less actual length
	JR	Z,WILPX		;go if done
	EX	DE,HL		;HL => buffer
WILPY	LD	(HL),' '	;load blank
	INC	HL		;bump pointer
	DEC	A		;less count
	JR	NZ,WILPY	;go for length
	EX	DE,HL		;DE => buffer
WILPX	POP	HL		;restore mem posit
	LD	C,(IY+30)	;get index offset
	LD	B,0		;BC = index
	ADD	HL,BC		;HL => next location
	PUSH	HL		;save it
	DEC	HL		;backspace by 3
	DEC	HL
	DEC	HL
	LD	C,3		;3 byte record #
	LDIR			;move it in
	POP	HL		;restore buff pointer
;
	DEC	(IY+13)		;less this record
	JR	NZ,WILP		;fill a block
;
	LD	(POSIT),HL	;save memory buffer
	LD	E,(IX+15)	;get fcb pointer
	LD	D,(IX+16)
;
	WRITE$			;write the sector
	RET	NZ		;go if any error
	LD	B,(IY+14)	;get records remaining
	LD	H,(IY+15)
	LD	L,(IY+16)
	LD	(IY+13),13	;13 records / sector
;
NXIND	CALL	DECBHL		;decrement BHL
	LD	A,B		;check for done
	OR	H
	OR	L
	RET	Z		;yes, done!, return Z
	DEC	(IY+13)		;less record
	JR	NZ,NXIND	;continue
	LD	(IY+14),B	;update counter
	LD	(IY+15),H
	LD	(IY+16),L
	JR	WOLP		;go outer loop
;
;	display error message
;
$ERROR	ERROR$			;display error
	RET			;done
;
;	error on sort I/O
;
SERROR	PUSH	AF		;save error code
	LD	HL,MSGS		;error text
	CALL	DISPLAY		;display error
	POP	AF		;restore error
	CALL	$ERROR		;display error message
	LD	HL,MSGS0	;'key to continue'
	CALL	DISPLAY		;display error
	CALL	INKEY		;wait for a key
	JP	EXIT		;go back to UTILITY
;
;	read current record into memory
;
READREC	LD	B,(IY+7)	;get relative record
	LD	H,(IY+8)
	LD	L,(IY+9)	;BHL = record #
	CALL	COMPSEC		;compute relative phys.
	LD	(IY+13),A	;save data offset
	LD	C,(IX+4)	;get start rec data
	LD	D,(IX+5)
	LD	E,(IX+6)	;CDE = start record
	CALL	ADDIT		;add CDE to BHL
	BIT	7,(IY+1)	;data in memory?
	RES	7,(IY+1)	;set NO record
	JR	Z,READRC1	;go if no record
;
;	check if record requested is already in memory
;
	LD	C,(IY+10)	;get phys rec in memory
	LD	D,(IY+11)
	LD	E,(IY+12)
	CALL	CMPBHL		;compare BHL <> CDE
	JR	Z,READRC2	;go if in memory!
;
;	read record from disk
;
READRC1	LD	(IY+10),B	;update phys record
	LD	(IY+11),H
	LD	(IY+12),L
	LD	E,(IX+15)	;get fcb address
	LD	D,(IX+16)
	LD	BC,SYSTEM+10	;point to record
;
	POSN$			;position to record
	RET	NZ		;go if error
	READ$			;read it
	RET	NZ		;go if error
;
READRC2	SET	7,(IY+1)	;set record in memory
	XOR	A		;return NO error
	RET			;done
;
;	exit program back to UTILITY module
;
CORRUPT	EQU	$
;
	IF	MOD2
	CALL	@VIDON		;enable video memory
	ENDIF
;
	LD	HL,MSG99	;error text
	LD	DE,@VIDEO	;start video memory
	LD	BC,MSG99L	;length of text
	LDIR			;move to video
DEAD	JP	DEAD		;hold here!
;
EXIT	LD	HL,PGM1		;UTILITY program
	LD	BC,RUNERR	;error vector
	JP	RUNPGM		;execute program
;
RUNERR	CALL	$ERROR		;display error
	LD	HL,MSGS0	;(key) to continue
	CALL	DISPLAY		;display message
	CALL	INKEY		;key to continue
	LD	HL,PGM2		;try to go to menu
	LD	BC,RUNERR	;error vector
	JP	RUNPGM		;try it out
;
;	convert binary A => ACB decimal ascii
;
ASCII	LD	B,'0'		;init MSB
ASCI1	SUB	100		;less 100's place
	JR	C,ASCI2		;go if found
	INC	B		;bump ascii
	JR	ASCI1		;go till found
;
ASCI2	ADD	A,100		;add back last sub
	PUSH	BC		;msb to stack
	LD	C,'0'		;init NSB
ASCI3	SUB	10		;less 10's place
	JR	C,ASCI4		;go if found
	INC	C		;bump ascii
	JR	ASCI3		;continue
;
ASCI4	ADD	A,'0'+10	;last sub + ascii
	LD	B,A		;pass to LSB
	POP	AF		;get msb back
	RET			;ACB = ascii
;
;	check if buffer at top of memory
;
IFTOP	TOPMEM$			;fetch topmem
	LD	DE,(POSIT)	;get memory posit
	DEC	H		;less one page for load
	OR	A		;clear carry flag
	SBC	HL,DE		;compare
	RET			;C = out of memory
;
;	load current record into memory
;
LOADREC	CALL	READREC		;read record
	RET	NZ		;go if error!
	LD	L,(IX+17)	;get I/O buff pointer
	LD	H,(IX+18)
	LD	E,(IY+13)	;data offset
	LD	D,0		;DE = offset
	ADD	HL,DE		;HL => record start
	PUSH	IX		;save fcb block
	LD	IX,SRTTBL	;sort lookup table
;
LOADRLP	PUSH	HL		;save data start
	LD	C,(IX+0)	;get data offset
	LD	B,0		;BC = offset
	ADD	HL,BC		;HL => data
	LD	B,(IX+1)	;get data length
	LD	DE,$		;get memory pointer
POSIT	EQU	$-2
LDRCAS	LD	A,(HL)		;get a byte
	CALL	UCASE		;make upper case
	LD	(DE),A		;to mem buffer
	INC	HL		;bump pointers
	INC	DE
	DJNZ	LDRCAS		;finish it off
	LD	(POSIT),DE	;save position
	POP	HL		;restore data start
	INC	IX		;bump table
	INC	IX		;2 byte entries
	LD	A,(IX+0)	;get first byte
	AND	(IX+1)		;check for terminator
	INC	A		;FFFFH?
	JR	NZ,LOADRLP	;finish the record
;
;	insert current record #
;
	LD	A,(IY+7)	;msb record
	LD	(DE),A		;to buffer
	INC	DE		;bump it
	LD	A,(IY+8)	;nsb record
	LD	(DE),A		;to buffer
	INC	DE		;bump it
	LD	A,(IY+9)	;lsb record
	LD	(DE),A		;to buffer
	INC	DE		;bump it
	LD	(POSIT),DE	;update pointer
;
	POP	IX		;unstack
	RET			;return Z
;
;	save sorted memory to temporary file
;
SAVETMP	LD	HL,(RECMEM)	;# recs in memory
	LD	A,H		;any?
	OR	L
	RET	Z		;nope, done!
	INC	(IY+26)		;bump current file
	LD	A,(IY+26)	;get file #
	CALL	ASCII		;3 bytes ascii
	LD	(FILETA),A	;to filespec
	LD	(FILETA+1),BC	;rest of it
	LD	HL,FILET	;temp file name
	LD	DE,FCBT		;temp fcb
	LD	BC,32		;max length
	PUSH	DE		;save fcb start
	LDIR			;move name in
	POP	DE		;unstack fcb address
	LD	HL,BUFFT	;temp I/O buffer
	CALL	ZBUFF		;clear buffer
;
	INIT$			;create file
	RET	NZ		;go on error!
;
;	allocate amount of space needed
;
	LD	HL,100H		;buffer size
	LD	C,(IY+30)	;get data field length
	LD	B,0		;BC = length
	XOR	A		;start count
CMPS1	OR	A		;clear carry
	SBC	HL,BC		;less record size
	JR	C,CMPS2		;go if found
	INC	A		;bump # records
	JR	CMPS1		;continue
CMPS2	ADD	HL,BC		;add back last subtract
	LD	C,3		;BC = 3 byte record
	OR	A		;clear carry
	SBC	HL,BC		;room for it?
	JR	NC,$+3		;go if room
	DEC	A		;less last record
	LD	(RECBUF),A	;save # records in buffer
	LD	B,0		;MSB = 0
	LD	HL,(RECMEM)	;BHL = records in memory
	CALL	TDIVD		;divide BHL / A
	OR	A		;any remainder?
	JR	Z,$+3		;go if not
	INC	HL		;bump product
	INC	HL		;+1 for index sector
	LD	DE,FCBT		;temp FCB pointer
	LD	(IY+27),L	;save # pages memory
	LD	(IY+23),B	;pass record #
	LD	(IY+24),H
	LD	(IY+25),L
	LD	BC,SYSTEM+23	;point to it
	POSN$			;position to record
	JR	Z,TMP0		;go if no error
	CP	1CH		;end of file?
	JR	Z,TMP0		;go if yes
	CP	1DH		;beyond file?
	RET	NZ		;nope, go error!
TMP0	WRITE$			;write the record
	RET	NZ		;go on allocate error!
;
	LD	BC,REWIND	;3 00's
	POSN$			;rewind file
	RET	NZ		;go on error
;
;	write # records to first sector
;
	LD	HL,BUFFT	;I/O buffer
	CALL	ZBUFF		;clear it out
	LD	A,(RECMEM)	;lsb recs in memory
	LD	(HL),A		;to buffer
	LD	A,(RECMEM+1)	;msb recs in memory
	INC	HL		;bump buffer
	LD	(HL),A		;to buffer
	LD	DE,FCBT		;temp FCB
;
	WRITE$			;write buffer
	RET	NZ		;go if error!
;
;	setup loop to write memory contents to file
;
	LD	HL,BUFFER	;start memory buffer
TMPLP	LD	DE,BUFFT	;I/O buffer
	EX	DE,HL		;HL => buffer
	CALL	ZBUFF		;load all zeroes
	EX	DE,HL		;swap back
	LD	A,'$'		;get # sectors
RECBUF	EQU	$-1
	LD	C,(IY+30)	;get record length
	LD	B,0		;BC = length
TMPLP0	PUSH	BC		;save length
	LDIR			;move in a block
	POP	BC		;restore
	DEC	A		;less count
	JR	NZ,TMPLP0	;finish off the block
	LD	DE,FCBT		;temp fcb address
	PUSH	HL		;save buffer address
;
	WRITE$			;write record
	POP	HL		;restore mem buffer
	RET	NZ		;go on disk error
	DEC	(IY+27)		;less sectors to write
	JR	NZ,TMPLP	;go till done
;
;	close temporary file
;
	LD	DE,FCBT		;temp FCB
;
	CLOSE$			;close file
	RET			;return with status
;
*GET	MAILS2			;sort/test
;
FCBT	DEFS	64		;file block temp files
BUFFT	DEFS	100H		;file block I/O buffer
;
LSTBUF	EQU	$&0FF00H	;last even page
BUFFX	EQU	LSTBUF+100H	;first even page
BUFFER	EQU	BUFFX+100H	;first even page
;
PGMEND	EQU	BUFFER+100H	;end of buffers
;
	END	ENTRY
