TITLE	'SAPP Sort & Pack Directory for CP/M 3.x'
;
; SAPP	v 1.5	Sort & Pack Directory for CP/M Plus	01/11/87
;			By George F. Reding
;		Based upon (and many routines from)
;		SAP v44 Sort & Pack program for CP/M 2.x
;		A Public Domain utility program.
;		Not to be sold (in whole or part).
;
; 01/11/87	Modified use of relative jumps to ensure they're
;   v1.5	used only to optimize speed (faster if condition
;		is NOT met).  Now use alt reg in SWITCH routine.
;		Some more comments added.	<GFR>
;
; 12/10/86	Uses alt regs in COMPR1 and PRNTL routines.
;   v1.4					<GFR>
;
; 11/15/86	Modified the program by removing some unused code
;   v1.3	and by utilizing z80 code anywhere possible.  Use
;		ZASM or other equivilent z80 assembler.
;						<GFR>
;
;--------------------------------------------------------------
;
TRUE	EQU	-1		; For conditional assembly
FALSE	EQU	0
;
VER	EQU	15		; Program version number
VERM	EQU	01		; Version month
VERD	EQU	11		; Version day
VERY	EQU	87		; Version year
;
DELZRO	EQU	FALSE		; True, to delete all zero-length files
				; Not beginning with "-" (as in SAP40).
				; False, if NOT to delete solely
				; On the basis of file size.
CLRSCR	EQU	FALSE		; True to clear screen on program start
CLR1	EQU	1BH		; Room for 5 bytes
CLR2	EQU	2AH		; Of code here
CLR3	EQU	00H		; In order to clear your screen
CLR4	EQU	00H		; Enter appropriate values for your
CLR5	EQU	00H		; Terminal, if CLRSCR is true.
;
HDRIVE	EQU	TRUE		; True if you have a hard disk drive.
HARDDK	EQU	'A'-41H		; Your hard disk designation,
				; If no hard disk, does not matter.
;
FAKDRM	EQU	TRUE		; True to fake a smaller MAXIMUM number
				; Of directory entries.
DRMSIZ	EQU	04H		; Fake value to store at DRM+1 if
				; Above is true, else does not matter.
;
ZERORC	EQU	TRUE		; False for almost all systems.
				; True, if using a Morrow or other
				; Which formats hard disk directory to 0E5H
VALURC	EQU	00H		; And with each directory RC field to 00H.
				; Unused, unless ZERORC is true.
;
SEKSIZ	EQU	1024		; Set to your largest sector size
;
;--------------------------------------------------------------
;
BDOS	EQU	0005H
DPBLEN	EQU	17		; Size of CP/M 3.x DPB
FCB	EQU	5CH
RESET	EQU	13		; Reset disk
GETDSK	EQU	25		; Get current disk
;
BEL	EQU	07H		; Bell
BS	EQU	08H		; Backspace
CR	EQU	0DH		; Carriage return
LF	EQU	0AH		; Line feed
;
;--------------------------------------------------------------
;
	ORG	100H
;
	JP	START
;
TITLM:	DB	'SAPP v'
	DB	VER/10+'0','.',VER MOD 10+'0',' '
	DB	VERM/10+'0',VERM MOD 10+'0','/'
	DB	VERD/10+'0',VERD MOD 10+'0','/'
	DB	VERY/10+'0',VERY MOD 10+'0',' GFR',CR,LF,0
	DB	1AH		; Eof in case com file typed
;
	 IF	CLRSCR
CLRSCR:	DB	CLR1,CLR2,CLR3	; Your clear screen code
	DB	CLR4,CLR5,00H
	 ENDIF
;
START:	LD	SP,STACK	; Use our own stack
;
	 IF	CLRSCR
	LD	HL,CLRCOD	; Clear your screen at start
	CALL	PRNTL		; Of program
	 ENDIF
;
	LD	HL,TITLM	; Program signon msg
	CALL	PRNTL
	LD	C,RESET		; Reset disk system
	CALL	BDOS		; In case new disk
;
	CALL	SETUP		; Select drive and make fake DPB
	CALL	RDDIR		; Read the directory
	CALL	CLEAN		; Set erased files to all E5
	CALL	SORT		; Sort the entries
	CALL	PACK
	CALL	WRDIR		; Write new directory back
;
	LD	HL,DONEM	; Done msg
	CALL	PRNTL
	LD	C,RESET		; Reset disk system
	CALL	BDOS		; Now that directory is changed
;
EXIT:	JP	0000H		; Go warm boot
;
;--------------------------------------------------------------
;			  Routines
;
;
; Select disk and create a fake DPB
;
SETUP:	LD	A,(FCB)		; Get any option
	DEC	A
	JP	P,SELDSK	; Skip over, if disk mentioned
	LD	C,GETDSK	; Otherwise get current default drive
	CALL	BDOS		; So query BDOS for drive
;
SELDSK:	LD	(LOGDSK),A	; Store selected disk
	LD	(BCREG),A	; Set C reg in BIOSPB
;
	LD	A,0		; First call flag
	LD	(DEREG),A	; Set E reg in BIOSPB
	LD	A,9		; BIOS function number
	CALL	XBIOS		; CP/M 3.x select
	LD	A,H
	OR	L		; Check for HL=0
	JR	Z,EXIT		; Quit if select error
;
	LD	E,(HL)		; Get address of xlat table
	INC	HL
	LD	D,(HL)
	EX	DE,HL
	LD	(RECTBL),HL	; Save xlat address
;
	LD	HL,11		; Offset to dpb address
	ADD	HL,DE		; HL=HL+11
	LD	A,(HL)		; Get adrress of DPB into HL
	INC	HL
	LD	H,(HL)
	LD	L,A		; Source in HL
	LD	DE,DPB		; Destination - our DPB
	LD	BC,DPBLEN	; Length of DPB
	LDIR			; Block move
;
	 IF	HDRIVE
	LD	A,(LOGDSK)	; Get selected disk
	CP	HARDDK		; Test if hard disk
	RET	NZ		; If not, return
	 ENDIF
;
	 IF	ZERORC
	LD	A,VALURC	; Get value for RC field
	LD	(FILLR2+1),A	; Store it here
	 ENDIF
;
	 IF	FAKDRM
	LD	A,DRMSIZ	; Fake value to store in DRM
	LD	(DRM+1),A	; To show less directory capacity
	 ENDIF
;
	RET
;
;
; Read/write directory routines
;
RDDIR:	LD	HL,READM	; Read msg
	CALL	PRNTL		; Zero was last in the A reg
	JP	DODIR
;
WRDIR:	LD	A,(NOSWAP)
	OR	A
	JP	NZ,WRDIR1
	LD	HL,PRESM	; Pre-sorted msg
	CALL	PRNTL
;
WRDIR1:	LD	HL,WRITM	; Write msg
	CALL	PRNTL
	LD	A,1		; Put 1 in A reg
;
DODIR:	LD	(WRFLAG),A	; Store for read/write
	LD	HL,(SYSTRK)	; Get number of system tracks
	LD	(LOGTRK),HL	; Set the track
	LD	HL,0
	LD	(RECORD),HL
	LD	HL,(DRM)	; Number of directory entries
	INC	HL		; Relative to 1
	OR	A		; Clear carry for division
	RR	H		; Divide hl by 2
	RR	L
	OR	A
	RR	H		; Again makes total division by 4
	RR	L		; To get 128-byte record count
	LD	(DIRCNT),HL
	LD	HL,BUF		; Get buffer addr
	LD	(DMAADR),HL	; For DMA address
;
DIRLOP:	LD	DE,(RECORD)	; Current record
	INC	DE		; Increment it
	LD	HL,(SPT)	; Get records per track
	OR	A		; Clear carry for subtraction
	SBC	HL,DE		; Subtract SPT - Records
	EX	DE,HL		; Current record to HL
	JR	NC,NOTROV
;
; Track overflow, bump to next
;
	LD	HL,(LOGTRK)	; Get current track
	INC	HL		; Increment it
	LD	(LOGTRK),HL	; Set the track
	LD	HL,1		; Rewind record number
;
NOTROV:	CALL	DOREC		; Set current record
	LD	A,(WRFLAG)	; Time to figure out
	OR	A		; If we are reading
	JP	NZ,DWRT		; Or writing
;
	CALL	READ		; Do the read
	OR	A		; Test flags on read
	JR	NZ,ERREXT	; NZ=error
	JP	MORE		; Good read, go do more
;
; Write
;
DWRT:	LD	C,1		; For CP/M 2.2 deblocking BIOSs
	CALL	WRITE
	OR	A		; Test flags on write
	JR	NZ,ERREXT	; NZ=bad directory write
;
; Good read or write
;
MORE:	LD	HL,(DMAADR)	; Get DMA address
	LD	DE,80H		; Add 128 bytes to it
	ADD	HL,DE		; For next pass
	LD	(DMAADR),HL
	LD	HL,(DIRCNT)	; Countdown entries
	DEC	HL
	LD	(DIRCNT),HL
	LD	A,H		; Test for zero left
	OR	L
	JP	NZ,DIRLOP	; Loop till zero
;
	LD	HL,80H		; Directory I/O done, reset DMA addr
	LD	(DMAADR),HL	; Set dma
	RET
;
;
; Come here on read/write error
;
ERREXT:	LD	HL,ERORM	; Error message
	CALL	PRNTL
	JP	EXIT		; Go warm boot
;
;
DOREC:	LD	(RECORD),HL	; Record update
	LD	B,H
	LD	C,L
	LD	HL,(RECTBL)
	EX	DE,HL
	DEC	BC
	CALL	RECTRN
	LD	B,H		; Moved to B, but unused
	LD	A,L
	LD	(LOGSEC),A	; Set sector
	RET
;
;
CLEAN:	LD	HL,0		; ICT = 0
;
CLNLOP:	LD	(ICT),HL
	CALL	INDEX		; HL = BUF + 16 * ICT
	LD	A,(HL)		; Jump if this is a deleted file
	CP	0E5H
	JP	Z,FILLR1
;
	 IF	DELZRO
	LD	DE,12
	ADD	HL,DE		; HL = HL + 12
	LD	A,(HL)		; Check extent field
	OR	A
	JP	NZ,CLBUMP	; Skip if not extent 0
	INC	HL		; Point to record count field
	INC	HL
	LD	A,(HL)		; Get S2 byte (extended RC)
	AND	0FH		; For CP/M 2.2, 0 for CP/M 1.4
	LD	E,A
	INC	HL
	LD	A,(HL)		; Check record count field
	OR	E
	JP	NZ,CLBUMP	; Jump if non-zero
	LD	HL,(ICT)	; Clear all 32 bytes of
	CALL	INDEX		; Directory entry to E5
	INC	HL
	LD	A,(HL)		; Get first char of filename
	DEC	HL		; MAST.CAT catalog programs
	CP	'-'		; Have diskname of zero length
	JP	Z,CLBUMP	; That start with "-", do not delete
	 ELSE
	JP	CLBUMP		; Do not delete this file
	 ENDIF
;
FILLR1:	LD	(HL),0E5H	; Fill source memory with E5
	LD	D,H		; Get hl addr to de
	LD	E,L
	INC	DE		; Destination = source + 1
	LD	BC,31		; Copy 31 times
	LDIR
;
	 IF	ZERORC		; For next 3 lines see VALURC note
	LD	DE,17		; Point to the RC
	SBC	HL,DE		; Adjust hl to it, by backing up
FILLR2:	LD	(HL),0E5H	; Set RC to E5 unless Morrow hard disk
	 ENDIF
;
;
CLBUMP:	LD	DE,(DRM)	; Get count of filenames
	INC	DE		; Increment it
	LD	HL,(ICT)	; Our current count
	INC	HL		; Increment it
	PUSH	HL
	OR	A		; Clear carry for subtraction
	SBC	HL,DE		; Subtract DRM from ICT
	POP	HL
	JP	C,CLNLOP	; Loop until all cleaned
	RET
;
;
; Sort the directory
;
SORT:	XOR	A
	LD	(NOSWAP),A	; Zero the flag in case pre-sorted
	LD	HL,SORTM	; Sort msg
	CALL	PRNTL
;
; Shell-Metzner sort
;
	LD	HL,(ICT)
	INC	HL
	LD	(SNRECW),HL
	LD	HL,BUF
	LD	(SSTADR),HL
	PUSH	HL		; Save it
	LD	HL,32
	LD	(SRECLN),HL
	PUSH	HL		; Save it
;
; Now divide # of fields by 2
;
DIVIDE:	LD	HL,(SNRECW)	; Get value
	OR	A		; Clear carry for division
	RR	H		; Divide hl by 2
	RR	L
	LD	(SNRECW),HL	; Save result
	LD	A,L		; If SNRECW <> 0
	OR	H		; Then
	JP	NZ,NDONE	; Not done
;
	POP	BC		; All fields sorted
	POP	DE		; So clean up stack
	RET
;
; Not done yet
;
NDONE:	EX	DE,HL
	LD	HL,(ICT)
	INC	HL
	OR	A		; Clear carry for subtraction
	SBC	HL,DE		; Hl = hl - de
	LD	(SRECLN),HL
	LD	HL,1
	LD	(SSRTV1),HL
	LD	(SSTADR),HL
	DEC	L
	POP	BC
	PUSH	BC
;
NDONE1:	ADD	HL,DE
	DEC	BC
	LD	A,B
	OR	C
	JP	NZ,NDONE1
	LD	(SSRTV2),HL
	EX	DE,HL
	POP	BC
	POP	HL
	PUSH	HL
	PUSH	BC
;
NDONE2:	LD	(SSRTV4),HL
	LD	(SSRTV3),HL
	EX	DE,HL
	ADD	HL,DE
	EX	DE,HL
;
COMPR:	POP	BC		; Get count
	PUSH	BC		; Save count
	PUSH	DE		; Save addresses of beginning
	PUSH	HL		; Of these 2 directory entries
;
COMPR1:	LD	A,(DE)		; Get (de) byte
	AND	7FH		; Strip parity (in case ro,sys,etc)
	PUSH	BC		; Save count
	EX	AF,AF'		; Use alt reg - saves (de) byte
	LD	A,(HL)		; Get (hl) byte
	AND	7FH		; Strip parity (for same reason)
	LD	B,A		; Save it
	EX	AF,AF'		; Restore reg - restores (de) byte
	SUB	B		; Subtr (hl) from (de)
	POP	BC		; Restore count
	JP	NZ,NOTEQU	; If not equal, jump over
	INC	HL		; Else bump
	INC	DE		; Both addresses
	DEC	BC		; Decr count
	LD	A,B		; Test
	OR	C		; For zero
	JP	NZ,COMPR1	; Do more if <> 0, else fall into next
;
NSWCH:	POP	HL		; Clean up the stack
	POP	HL		; And again
NSWCH1:	LD	DE,(SSTADR)
	INC	DE
	LD	(SSTADR),DE
	LD	(SSRTV1),DE
	LD	HL,(SRECLN)
	OR	A		; Clear carry
	SBC	HL,DE		; Subtract hl - de
	JP	C,DIVIDE
	LD	HL,(SSRTV4)
	POP	DE
	PUSH	DE
	ADD	HL,DE
	LD	DE,(SSRTV2)
	JP	NDONE2
;
;
; The condition at NOTEQU has to be changed for descending sort
;
NOTEQU:	JP	NC,NSWCH
	LD	A,1
	LD	(NOSWAP),A
	POP	HL		; Get back addresses of beginning
	POP	DE		; Of these 2 directory entries
	POP	BC		; And the number of bytes.
	PUSH	BC		; Leave this on the stack
;
SWITCH:	LD	A,(HL)		; Get (hl) byte
	EX	AF,AF'		; Save it
	LD	A,(DE)		; Get (de) byte
	LD	(HL),A		; Store in (hl)
	EX	AF,AF'		; Get old (hl) back
	LD	(DE),A		; Store in (de)
;
	INC	HL		; Bump both
	INC	DE		; Addresses
	DEC	BC		; Decr count
	LD	A,B		; Test
	OR	C		; For zero
	JP	NZ,SWITCH	; Go do more if <> 0
	LD	HL,(SNRECW)
	LD	A,H
	CPL
	LD	D,A
	LD	A,L
	CPL
	LD	E,A
	LD	HL,(SSRTV1)
	ADD	HL,DE
	JP	NC,NSWCH1
	INC	HL
	LD	(SSRTV1),HL
	LD	DE,(SSRTV3)
	LD	HL,(SSRTV2)
	LD	A,E		; Subtr hl from de
	SUB	L
	LD	L,A
	LD	A,D
	SBC	A,H
	LD	H,A		; Result in hl, de unaffected
	LD	(SSRTV3),HL	; Store result here
	JP	COMPR
;
;
PACK:	LD	HL,0		; ICT = 0
;
PACK1:	LD	(ICT),HL
	CALL	INDEX		; HL = BUF + 16 * ICT
	LD	DE,9
	ADD	HL,DE		; HL = HL + 9
	LD	A,(HL)		; Jump if filetype not "X$$"
	SUB	'0'
	JP	C,PACK2
	CP	10
	JP	NC,PACK2
	LD	(JCT),A
	INC	HL
	LD	A,(HL)
	CP	'$'
	JP	NZ,PACK2
	INC	HL
	LD	A,(HL)
	CP	'$'
	JP	NZ,PACK2
	INC	HL		; Set extent number to x
	LD	A,(JCT)
	LD	(HL),A
	DEC	HL		; Set filetype to "$$$"
	LD	(HL),'$'
	DEC	HL
	LD	(HL),'$'
	DEC	HL
	LD	(HL),'$'
;
PACK2:	LD	HL,(ICT)
	INC	HL		; ICT = ICT + 1
	LD	DE,(DRM)
	INC	DE		; DRM = DRM + 1
	PUSH	HL
	OR	A		; Clear carry for subtraction
	SBC	HL,DE		; Subtract DRM from ICT
	POP	HL		; Loop until ICT > DRM
	JP	C,PACK1
	RET
;
;
INDEX:	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	LD	DE,BUF
	ADD	HL,DE
	RET
;
;
; Print nul terminated string pointed to by hl
;
PRNTL:	LD	A,(HL)		; Get char
	OR	A		; Test for zero
	RET	Z		; If yes, we are done
	EXX			; Use alt regs
	LD	E,A		; Get char to e for output
	LD	C,2
	CALL	BDOS		; Send to console
	EXX			; Restore normal regs
	INC	HL		; Point to next
	JP	PRNTL		; Try to do more
;
;
;--------------------------------------------------------------
;
; Translate sectors.  Sectors are not translated yet. Wait until we
; know the physical sector number. This works fine as long as the
; program trusts the BIOS to do translation.  Some programs access
; the XLAT table directly to do their own translation.	These programs
; will get the wrong idea about disk skew but it should cause no harm.
;
RECTRN:	LD	L,C		; Return sector in HL
	LD	H,B
	RET
;
; Read the selected CP/M sector.
;
READ:	LD	A,1
	LD	(READOP),A	; Read operation
	INC	A		; A=2 (wrual)
	LD	(WRTYPE),A	; Treat as unalloc
	JP	ALLOC		; Perform read
;
; Write the selected CP/M sector.
;
WRITE:	XOR	A
	LD	(READOP),A	; Not a read operation
	LD	A,C
	LD	(WRTYPE),A	; Save write type
	CP	2		; Unalloc block?
	JP	NZ,CHKUNA
;
; Write to first sector of unallocated block.
;
	LD	A,(EXM)		; Get block shift mask
	INC	A		; Adjust value
	LD	(UNACNT),A	; Unalloc record count
	LD	A,(LOGDSK)	; Set up values for
	LD	(UNADSK),A	; Writing to an unallocated
	LD	A,(LOGTRK)	; Block
	LD	(UNATRK),A
	LD	A,(LOGSEC)
	LD	(UNASEC),A
;
CHKUNA:	LD	A,(UNACNT)	; Any unalloc sectors
	OR	A		; In this block
	JP	Z,ALLOC		; Skip if not
	DEC	A		; --unacnt
	LD	(UNACNT),A
	LD	A,(LOGDSK)
	LD	HL,UNADSK
	CP	(HL)		; Logdsk = unadsk ?
	JP	NZ,ALLOC	; Skip if not
	LD	A,(LOGTRK)
	CP	(HL)		; Logtrk = unatrk ?
	JP	NZ,ALLOC	; Skip if not
	LD	A,(LOGSEC)
	LD	HL,UNASEC
	CP	(HL)		; Logtrk = unasec ?
	JP	NZ,ALLOC	; Skip if not
	INC	(HL)		; Move to next sector
	LD	A,(HL)
	LD	HL,SPT		; Addr of spt
	CP	(HL)		; Sector > spt ?
	JP	C,NOOVF		; Skip if no overflow
	LD	HL,(UNATRK)
	INC	HL
	LD	(UNATRK),HL	; Bump track
	XOR	A
	LD	(UNASEC),A	; Reset sector count
NOOVF:	XOR	A
	LD	(RSFLAG),A	; Do not pre-read
	JP	RWOPER		; Perform write
;
ALLOC:	XOR	A		; Requires pre-read
	LD	(UNACNT),A
	INC	A
	LD	(RSFLAG),A	; Force pre-read
;
RWOPER:	XOR	A
	LD	(ERFLAG),A	; No errors yet
	LD	A,(PSH)		; Get physical shift factor
	OR	A		; Set flags
	LD	B,A
	LD	A,(LOGSEC)	; Logical sector
	LD	HL,HSTBUF	; Addr of buffer
	LD	DE,128
	JP	Z,NOBLK		; No blocking
	EX	DE,HL		; Shuffle registers
SHIFT:	EX	DE,HL
	RRCA
	JP	NC,SH1
	ADD	HL,DE		; Bump buffer address
SH1:	EX	DE,HL
	ADD	HL,HL
	AND	07FH		; Zero high bit
	DJNZ	SHIFT
	EX	DE,HL		; HL=buffer addr
NOBLK:	LD	(SEKHST),A
	LD	(SEKBUF),HL
	LD	HL,HSTACT	; Buffer active flag
	LD	A,(HL)
	LD	(HL),1		; Set buffer active
	OR	A		; Was it already?
	JP	Z,FILHST	; Fill buffer if not
	LD	A,(LOGDSK)
	LD	HL,HSTDSK	; Same disk ?
	CP	(HL)
	JP	NZ,NMATCH
	LD	A,(LOGTRK)
	LD	HL,HSTTRK	; Same track ?
	CP	(HL)
	JP	NZ,NMATCH
	LD	A,(SEKHST)	; Same buffer ?
	LD	HL,HSTSEC
	CP	(HL)
	JP	Z,MATCH
;
NMATCH:	LD	A,(HSTWRT)	; Buffer changed?
	OR	A
	CALL	NZ,WRTHST	; Clear buffer
;
FILHST:	LD	A,(LOGDSK)
	LD	(HSTDSK),A
	LD	HL,(LOGTRK)
	LD	(HSTTRK),HL
	LD	A,(SEKHST)
	LD	(HSTSEC),A
	LD	A,(RSFLAG)	; Need to read ?
	OR	A
	CALL	NZ,REDHST	; Yes
	XOR	A
	LD	(HSTWRT),A	; No pending write
;
MATCH:	LD	DE,(DMAADR)
	LD	HL,(SEKBUF)
	LD	A,(READOP)	; Which way to move ?
	OR	A
	JP	NZ,RWMOVE	; Skip if read
	LD	A,1
	LD	(HSTWRT),A	; Mark buffer changed
	EX	DE,HL		; Hl=dma  de=buffer
;
RWMOVE:	LD	BC,128		; Byte count
	LDIR			; Block move
	LD	A,(WRTYPE)	; Write type
	CP	1		; To directory ?
	JP	NZ,RWEXIT	; Done
	LD	A,(ERFLAG)	; Check for errors
	OR	A
	JP	NZ,RWEXIT	; Do not write dir if so
	XOR	A
	LD	(HSTWRT),A	; Show buffer written
	CALL	WRTHST		; Write buffer
RWEXIT:	LD	A,(ERFLAG)
	RET
;
; Disk read.  Call bios to fill the buffer with one physical sector.
;
REDHST:	CALL	RWINIT		; Init CP/M 3.x BIOS
	LD	A,13		; Read function number
	JP	DORW		; Go do it
;
; Disk write.  Call bios to write one physical sector from buffer.
;
WRTHST:	CALL	RWINIT		; Init CP/M 3.x BIOS
	LD	A,14		; Write function number
;
; Call bios to read (or write) 1 physical sector to (or from) buffer.
;
DORW:	CALL	XBIOS		; Go do it to the sector
	LD	(ERFLAG),A
	RET
;
; Translate sector, set track, sector, DMA buffer and DMA bank.
;
RWINIT:	LD	HL,(HSTTRK)	; Physical track number
	LD	(BCREG),HL	; Track number in BC
	LD	A,10		; Settrk function number
	CALL	XBIOS
;
	LD	A,(HSTSEC)	; Physical sector number
	LD	L,A
	LD	H,0
	LD	(BCREG),HL	; Sector number in BC
	LD	HL,(RECTBL)	; Address of xlat table
	LD	(DEREG),HL	; Xlat address in DE
	LD	A,16		; Sectrn function number
	CALL	XBIOS		; Get skewed sector number
;
	LD	A,L
	LD	(ACTSEC),A	; Actual sector
	LD	(BCREG),HL	; Sector number in BC
	LD	A,11		; Setsec function number
	CALL	XBIOS		; Set CP/M 3.x sector
;
	LD	HL,HSTBUF	; Sector buffer
	LD	(BCREG),HL	; Buffer address in BC
	LD	A,12		; Setdma function number
	CALL	XBIOS
;
	LD	A,1		; DMA bank number
	LD	(AREG),A	; Bank number in A
	LD	A,28		; Setbnk function number
	CALL	XBIOS		; Set DMA bank
	RET
;
; Routine to call banked BIOS routines via BDOS function 50.
; All disk I/O calls are made through here.
;
XBIOS:	LD	(BIOSPB),A	; Set BIOS function
	LD	C,50		; Direct BIOS call function
	LD	DE,BIOSPB	; BIOS parameter block
	JP	BDOS		; Jump to BDOS
;
BIOSPB:	DB	0		; BIOS function
AREG:	DB	0		; A register
BCREG:	DW	0		; BC reg
DEREG:	DW	0		; DE reg
HLREG:	DW	0		; HL reg
;
; Messages
;
DONEM:	DB	'Done',CR,LF,0
READM:	DB	CR,LF,'Read, ',0
PRESM:	DB	'(Pre-sorted) ',0
WRITM:	DB	'Write, ',0
ERORM:	DB	BS,BS,' Error',BEL,CR,LF,0
SORTM:	DB	'Sort, ',0
;
; Data area
;
DIRCNT:	DS	2
ICT:	DS	2
JCT:	DS	2
NOSWAP:	DS	1
RECTBL:	DS	2
RECORD:	DS	2
WRFLAG:	DS	1
SRECLN:	DS	2
SSTADR:	DS	2
SSRTV1:	DS	2
SSRTV2:	DS	2
SSRTV3:	DS	2
SSRTV4:	DS	2
SNRECW:	DS	2
;
; Disk parameter block
;
DPB:
SPT:	DS	2
BSH:	DS	1
BLM:	DS	1
EXM:	DS	1
DSM:	DS	2
DRM:	DS	2
AL0:	DS	1
AL1:	DS	1
CKS:	DS	2
SYSTRK:	DS	2
PSH:	DS	1		; Phy shift count
PSM:	DS	1		; Phy sector mask
;
; Disk I/O buffer
;
HSTBUF:	DS	SEKSIZ
;
; Variable storage area
;
LOGDSK:	DS	1		; Logical disk number
LOGTRK:	DS	2		; Logical track number
LOGSEC:	DS	1		; Logical sector number
;
HSTDSK:	DS	1		; Phy disk number
HSTTRK:	DS	2		; Phy track number
HSTSEC:	DS	1		; Phy sector number
;
ACTSEC:	DS	1		; Skewed phy sector
SEKHST:	DS	1		; Temp phy sector
HSTACT:	DB	0		; Buffer active flag, initial zero
HSTWRT:	DB	0		; Buffer changed flag, initial zero
;
UNACNT:	DS	1		; Unallocated sector count
UNADSK:	DS	1		; Unalloc disk number
UNATRK:	DS	2		; Unalloc track number
UNASEC:	DS	1		; Unalloc sector number
SEKBUF:	DS	2		; Logical sector address in buffer
;
ERFLAG:	DS	1		; Error reporting
RSFLAG:	DS	1		; Force sector read
READOP:	DS	1		; 1 if read operation
WRTYPE:	DS	1		; Write operation type
DMAADR:	DS	2		; Last dma address
;
	DS	32		; Minimum stack depth
EVEN	EQU	($+255)/256*256	; Start buffer on even page, also
				; Increases stack area greatly
	ORG	EVEN
STACK	EQU	$-2
BUF:	DS	0
;
	END