;
;************************************************
;						*
; copyright (c) 1980,1981 tarbell electronics	*
;						*
;************************************************
;
	TITLE	'MP/M V2.0 Loader 10-22-81'
;
; deblock mpm loader program
; for the double density controller board
; and the tarbell cpu/io board.
; this program and the mpm xios use
; z80 code only. you must use the assembler
; called zasm.com or use the macro assembler
; with the macro file z80.lib.
; distribution of this software is a violation
; of copyright laws.
;
TRUE	EQU	-1
FALSE	EQU	0
;
;---------------------------------------------------------------
;          this is the area you change for
;		your situation
;---------------------------------------------------------------
;
MAC	EQU	FALSE	;true if using macro assembler
TARBELL	EQU	TRUE	;true if using a tarbell cpu board
CONSL1	EQU	TRUE	;true if using 2 consoles,
CONSL2	EQU	TRUE	;and,,true if using 3 consoles,
CONSL3	EQU	TRUE	;and,,true if using 4 consoles,
CONSL4	EQU	TRUE	;and,,true if using 5 consoles.
DMACNTL	EQU	TRUE	;true if using dma control
STPRAT	EQU	0	;0=3ms,1=6ms,2=10ms,3=15ms(drv stp rate)
HLAB	EQU	8	;0=no head load at beginning of seek
ERCNT	EQU	10	;error retry count
;
;i/o equates
;
	IF	TARBELL
IOBAS	EQU	00H	;00 or 10h for iobase on tarbell cpu
IOBAS1	EQU	10H	;iobase for 4 port serial board
	ELSE
IOBAS	EQU	10H
IOBAS1	EQU	40H
	ENDIF
;
	IF	TARBELL
CCOM	EQU	IOBAS+1		;init port
CSTAT	EQU	IOBAS+1		;status port
CDATA	EQU	IOBAS+0		;data port
CIMASK	EQU	00000010B
COMASK	EQU	00000001B
;
	ELSE			;using a vdb-8024
;
CCOM	EQU	0		;init port for console
CSTAT	EQU	0		;console status port
CDATA	EQU	1		;console data port
CIMASK	EQU	00000010B	;input mask value
COMASK	EQU	00000100B	;output mask value
	ENDIF
;
LCOM	EQU	IOBAS +03H	;init port for lister
CCOM1	EQU	IOBAS1+01H
CCOM2	EQU	IOBAS1+03H
CCOM3	EQU	IOBAS1+05H
CCOM4	EQU	IOBAS1+07H	;4 port serial board init ports
;
;--------------------------------------------------------------
; timer equates
;
TCH0	EQU	IOBAS+4		;timer chan 0 address
TCH1	EQU	IOBAS+5		;timer chan 1 address
TCH2	EQU	IOBAS+6		;timer chan 2 address
TCMND	EQU	IOBAS+7		;timer command port
IMASK	EQU	IOBAS+8		;interrupt masking port
CNTR0	EQU	00000000B	;counter 0
CNTR1	EQU	01000000B	;counter 1
CNTR2	EQU	10000000B	;counter 2
RLWORD	EQU	00110000B	;read/load lsb 1st, msb 2nd.
RLHBYTE	EQU	00100000B	;read/load msb only.
RLLBYTE	EQU	00010000B	;read/load lsb only.
CNTRLT	EQU	00000000B	;counter latching operation.
BINARY	EQU	00000000B	;select binary operation.
BCD	EQU	00000001B	;select bcd operation.
MODE0	EQU	00000000B	;interrupt on terminal count.
MODE1	EQU	00000010B	;programmable one-shot.
MODE2	EQU	00000100B	;rate generator.
MODE3	EQU	00000110B	;square wave rate generator.
MODE4	EQU	00001000B	;software triggered strobe.
MODE5	EQU	00001010B	;hardware triggered strobe.
;
NDISK	EQU	1		;number of drives
DMAP	EQU	0E0H		;dma port base address
ADR0	EQU	DMAP+0		;dma address register
WCT0	EQU	DMAP+1		;dma word count register
CMND	EQU	DMAP+8		;dma command register
DADR	EQU	0F8H		;disk address
DCOM	EQU	DADR		;disk command port
DSTAT	EQU	DADR		;disk status port
TRACK	EQU	DADR+1		;disk track register
SECTP	EQU	DADR+2		;disk sector register
DDATA	EQU	DADR+3		;disk data register
WAIT	EQU	DADR+4		;wait for data-interrupt
DMACHK	EQU	DADR+5		;non-wait status port
EXTADD	EQU	DMACHK		;extended address latch
DMAR	EQU	01000000B	;dma read command
DMAW	EQU	10000000B	;dma write command
FREAD	EQU	10000000B	;floppy read command
FWRIT	EQU	10100000B	;floppy write command
RDID	EQU	11000000B	;read id command
B128	EQU	128		;sgl / dbl den. sect size
B512	EQU	512		;deblock sector size
;
;cp/m to host disk constants
;
BLKSIZ	EQU	2048		;cp/m allocation size
HSTSIZ	EQU	512		;host disk sector size
HSTSPT	EQU	16		;host disk sectors/trk
HSTBLK	EQU	HSTSIZ/128	;cp/m sects/host buff
CPMSPT	EQU	HSTBLK * HSTSPT	;cp/m sectors/track
SECMSK	EQU	HSTBLK-1	;sector mask
SECSHF	EQU	2		;log2(hstblk)
;
;bdos constants on entry to write
;
WRDIR	EQU	1		;write to directory
WRUAL	EQU	2		;write to unallocated
;
	IF	MAC
	MACLIB	Z80
	ENDIF
;
	ORG	1700H		;origin of this program
;
;	jump vector for individual subroutines
;
	JMP	INIT		;init i/o devices
WBOOTE:	JMP	EMPRET		;warm start
	JMP	CONST		;console status
	JMP	EMPRET		;console character in
	JMP	CONOUT		;console character out
	JMP	EMPRET		;list character out
	JMP	EMPRET		;punch character out
	JMP	EMPRET		;reader character out
	JMP	HOME		;move head to home
	JMP	SELDSK		;select disk
	JMP	SETTRK		;set track number
	JMP	SETSEC		;set sector number
	JMP	SETDMA		;set dma address
	JMP	READ		;read disk
	JMP	EMPRET		;write disk
	JMP	EMPRET		;return list status
	JMP	SECTRA		;sector translate
;
EMPRET:	XRA	A		;function not used
	RET
;
;init i/o devices
;
INIT:	LXI	H,INITT		;point to init table
	MVI	B,(INITE-INITT)	;count
OLOOP:	MOV	A,M		;get a byte from table
	OUT	CCOM
	OUT	LCOM

	IF	CONSL1
	OUT	CCOM1
	ENDIF

	IF	CONSL2
	OUT	CCOM2
	ENDIF

	IF	CONSL3
	OUT	CCOM3
	ENDIF

	IF	CONSL4
	OUT	CCOM4
	ENDIF

	INX	H		;bump pointer
	DJNZ	OLOOP
	RET
;
;8251 init table
;
INITT:	DB	0AAH,040H,0CEH,037H
INITE:	DS	0
FLAG:	DB	0
;
;
INIT1:	DI			;kill any interrupts
	MVI	A,07EH		;set intrp mask bits to on
	OUT	IMASK		;this will stop any intrps.
	LDA	FLAG		;check if init before
	ORA	A		;= 0?
	RNZ			;return, its done once
	INR	A		;1st time, set = 1
	STA	FLAG		;and save it
	CALL	INIT		;init i/o devices
;
	LXI	H,BEGDAT	;clear scratch area
	LXI	D,BEGDAT+1	;block transfer dest.
	LXI	B,HSTBUF-BEGDAT+1	;count
	XRA	A		;clear a
	MOV	M,A		;set first loc. = 0
	LDIR			;use block move to clear
;
;set timer to stop running
;
	MVI	A,CNTR2+RLWORD+MODE2+BINARY	;timer values
	OUT	TCMND		;send it
	MVI	A,1		;stop timer
	OUT	TCH2
	DCR	A
	OUT	TCH2
	OUT	EXTADD		;clear extended latch
	IN	IMASK		;clear interrupt latch
	RET
;
;fixed data tables for three-drive standard
;ibm-compatible 8" disks
;disk parameter header for disk 00
;
DPBASE:	DW	TRANS,0000H
	DW	0000H,0000H
	DW	DIRBF,DPBLK1
	DW	CHK00,ALL00
;
;	sector translate vector
;
TRANS:	DB	1,7,13,19	;sectors 1,2,3,4
	DB	25,5,11,17	;sectors 5,6,7,8
	DB	23,3,9,15	;sectors 9,10,11,12
	DB	21,2,8,14	;sectors 13,14,15,16
	DB	20,26,6,12	;sectors 17,18,19,20
	DB	18,24,4,10	;sectors 21,22,23,24
	DB	16,22		;sectors 25,26

;
;	disk parameter block, single density
;
DPBLK1:	DW	26		;sectors per track
	DB	3		;block shift factor
	DB	7		;block mask
	DB	0		;null mask
	DW	242		;disk size-1
	DW	63		;directory max
	DB	192		;alloc 0
	DB	0		;alloc 1
	DW	16		;check size
	DW	2		;track offset
;
;	double density disk parameter block
;
DPBLK2:	DW	51		;sectors per track
	DB	4		;block shift factor
	DB	15		;block mask
	DB	0		;extent mask
	DW	237		;disk size-1
	DW	127		;directory max
	DB	192		;alloc 0
	DB	0		;alloc 1
	DW	32		;check size
	DW	2		;track offset
;
;	double density disk parameter block
;
DPBLK3:	DW	64		;sectors per track
	DB	4		;block shift factor
	DB	15		;block mask
	DB	0		;null mask
	DW	299		;disk size-1
	DW	127		;directory max
	DB	11000000B	;alloc 0
	DB	0		;alloc 1
	DW	32		;check size
	DW	2		;track offset
;
;defines a double density / double side 51 x 128
;
DPBLK5:	DW	51
	DB	5
	DB	31
	DB	0
	DW	237
	DW	95
	DB	11000000B
	DB	0
	DW	24
	DW	2
;
;defines a double density / double side 512 x 16
;
DPBLK6:	DW	64
	DB	5
	DB	31
	DB	0
	DW	303
	DW	169
	DB	11000000B
	DB	0
	DW	42
	DW	2
;
;	end of fixed tables
;
CONST:	IN	CSTAT
	ANI	CIMASK
	MVI	A,0
	RZ
	CMA
	RET
;
;character out to console
;
CONOUT:	IN	CSTAT		;check output status
	ANI	COMASK		;mask
	JRZ	CONOUT		;loop till not busy
	MOV	A,C		;get cpm character
	OUT	CDATA		;send to console
	RET
;
; translate the sector given by bc using the
; translate table given by de
;
SECTRA:	MOV	L,C		;double density part
	MOV	H,B
	LDA	DISKHF
	CPI	3		;sector 0-63 for format 3
	RNC
	INR	L		;just increment 0-51 to 1-52
	CPI	2
	RZ
	XCHG			;single density xlat
	DAD	B
	MOV	L,M
	MVI	H,0
	RET
;
;home - restore to track 0 with head loaded
;
HOME:	LDA	HSTWRT		;check for pending write
	ORA	A
	JRNZ	HOME1
	STA	HSTACT		;host inactive
HOME1:	LXI	B,0		;restore
;
;settrk - select track 0 - 76
;
SETTRK:	SBCD	SEKTRK
	RET
;
;seldsk
;always done prior to settrk,setsec,
;and init i/o ports if not done.
;
SELDSK:	EXX			;save all registers
	CALL	INIT1		;init i/o ports if not done
	EXX			;get them back
	MOV	A,C
	CPI	NDISK		;number of defined drives
	LXI	H,0
	RNC			;return with hl=0 on error
	STA	SEKDSK		;system disk select save
	ADD	A		;double for indexing
	MOV	C,A		;put into reg c
	MVI	B,0		;clear reg b
	LXI	H,DSKLOG	;point to disk log vector
	DAD	B		;get logon location
	MOV	A,M		;get format
;
;store format flag
;
	STA	DISKHF		;save it for system reference
;
; 0 = unlogged
; 1 = single density
; 2 = double density (51 secs - 128 b)
; 3 = double density (16 secs - 512 b)
;
;example:
;for double density 512x16:
;
;	lxi	h,3 * 256 + 8
;
;3 = use deblock part of bios (reg h)
;8 = set bit 3 to a '1' for doub density ( reg l )
;
;for double density 512x16 doub sided:
;
;	lxi	h,3 * 256 + 48h
;
;3 = use deblock part of bios (reg h)
;48h = set bit 3 '1' for doub den
;      set bit 6 '1' for doub sided ( reg l)
;
	INX	H		;get disk pointer address
	ORA	A		;logged on?
	MOV	A,M
	STA	DISKHS		;store selected disk wait port
	JNZ	LOGGED
	PUSH	H
	OUT	WAIT		;at single density
	CALL	HDLAY		;head settle time
	MVI	A,(STPRAT+1)+HLAB	;restore drive
	CALL	EXECC1		;restore to track 0
	MVI	A,1
	OUT	SECTP		;address sector 1
	LXI	H,DIRBF
	CALL	READLS		;read a logical sector
	LDA	DIRBF+7EH
	CPI	0DEH		;double density 16 secs of 512?
	JRZ	DD64
	CPI	0DCH		;512 x 16 doub sided?
	JRZ	DD642
	CPI	0DFH		;128 x 51 doub sided?
	JRZ	DD52
	CPI	0DDH		;double density 51 secs?
	JRZ	DD51
	LXI	H,1*256 + 0	;format flag and density mask
	LXI	D,DPBLK1	;single density parm block
SD2A:	LXI	B,TRANS		;sector translate table
	JMPR	PUT
;
DD642:	LXI	H,3*256 + 48H
	LXI	D,DPBLK6
	JMPR	PUT1
;
DD52:	LXI	H,2*256 + 48H
	LXI	D,DPBLK5
	JMPR	PUT1
;
DD51:	LXI	H,2*256 + 8	;as above for 51 secs ddens
	LXI	D,DPBLK2
	JMPR	PUT1

DD64:	LXI	H,3*256 + 8	; 64 logical secs (16 by 512)
	LXI	D,DPBLK3
PUT1:	LXI	B,0
PUT:	MOV	A,L		;disk density mask
	XTHL			; pointer to disk hardware
	ORA	M		;add in density mask
	MOV	M,A		;and save
	STA	DISKHS		; (value for selected disk)
	DCX	H		;back up to format address
	XTHL
	MOV	A,H		;format type
	POP	H
	MOV	M,A		;save type (0, 1, 2, 3)
	STA	DISKHF
	PUSH	B
	LDA	SEKDSK		;fix up dpbase tables
	ADD	A
	ADD	A
	ADD	A
	ADD	A	
	MOV	C,A
	MVI	B,0
	LXI	H,DPBASE	; reference table for this disk
	DAD	B
	POP	B
	MOV	M,C		;copy translate table address
	INX	H
	MOV	M,B
	LXI	B,9
	DAD	B
	MOV	M,E		;copy parameter block address
	INX	H
	MOV	M,D

LOGGED:	LDA	DISKHS
	ANI	0B0H		;eliminate density from address
	MOV	E,A
	MVI	D,0
	LXI	H,DPBASE
	DAD	D
	RET
;
;setsec - set sector from
;
SETSEC:	MOV	A,C		;check parameters
	STA	SEKSEC
	RET
;
;setdma - set dma address from bc
;
SETDMA:	SBCD	DMAADR		;bc to dmaadr
	RET
;
;read - read a sector
;
READ:	LDA	SEKTRK		;bypass format 3 if track 0
	ORA	A
	JRZ	READ1
	LDA	DISKHF		;if format 3 then deblock
	CPI	3
	JZ	READB
READ1:	LDA	SEKSEC
	MOV	D,A
	LDA	DISKHS
	MOV	B,A
	LDA	SEKTRK
	CALL	SEEKLS
	LHLD	DMAADR
	CALL	RDTEST		;track 0,1 test
	JMP	READLS		;read logical sector
;
RDTEST:	CALL	TRTEST		;see if phantom track
	RNC
	LXI	B,127
	MOV	D,H
	MOV	E,L
	INX	D
	MVI	M,0
	LDIR
	JMPR	TESTDN
;
WRTEST:	CALL	TRTEST		;see if phantom track
	RNC
TESTDN:	POP	B		;scrap 1 subroutine
	XRA	A
	RET
;
TRTEST:	IN	TRACK		;test track
	CPI	1
	RNC
	IN	SECTP
	ORA	A
	JRZ	TSTC
	IN	TRACK
	DCR	A
	JRZ	TRK1
	IN	SECTP
	CPI	27
	CMC
	RET
TRK1:	IN	SECTP
	CPI	52
TSTC:	CMC
	RET
;
; -read logical sector-
;bc, de unchanged
;hl is dma address
;hl returned hl + length
;
	IF	DMACNTL		;if using dma
READLS:	PUSH	B		;save bc
	PUSH	D		;save de
	MVI	A,ERCNT		;retry count
RRTRY:	STA	RTCNT		;save it
	PUSH	H		;save dma address
	LXI	B,FREAD SHL 8 OR WCT0
	LDA	DISKHF		;check if deblocking
	CPI	3		;if = 3, deblocking
	LXI	D,DMAR SHL 8 OR B512
	JRNC	RSET		;we are deblocking
	LXI	D,DMAR SHL 8 OR B128
RSET:	CALL	DMARW		;use common read/write
	ANI	9DH		;check for errors during read
	JRZ	REXIT2		;exit if none
	POP	H		;recover address, error occured
	LDA	RTCNT		;get retry count
	DCR	A		;decrement it
	JRNZ	RRTRY		;retry again

	ELSE

READLS:	PUSH	B		;save	bc, de
	PUSH	D
	LXI	B,ERCNT*256 + WAIT
RRTRY:	MVI	A,80H
	OUT	DCOM		;read a block
	CALL	HDLAY		;delay for head load
	PUSH	H
	XCHG
	LXI	H,RLOOP		;set up for fast transfer
RLOOP:	INP	A		;read port c and set status
	JP	RDONE
	IN	DDATA		;read byte
	STAX	D
	INX	D
	PCHL
;
RDONE:	IN	DSTAT
	ANI	9DH
	JRZ	REXIT		;return on good read
	POP	H
	DJNZ	RRTRY
	ENDIF

	MVI	A,1
	ORA	A		;set status
	JMPR	REXIT1

	IF	NOT DMACNTL
REXIT:	XCHG			;put next address in hl
	ENDIF

REXIT2:	POP	D		;throw away orig. dma
REXIT1:	POP	D		;restore de
	POP	B		;restore bc
	RET
;
;delay routine
;
HDLAY:	PUSH	B		;save b,c
	MVI	B,32		;count of 32 = 105 usec at 4mhz
WEXITL:	DJNZ	WEXITL		;loop till done
	POP	B		;restore b,c
	RET
;
;logical sector seek
;
;a=track, b=hardware and density for fdc
;d=sector (for future read)
;
SEEKLS:	PUSH	PSW
	MVI	A,10		;retrys
	STA	SEEKRTY		;save it
	PUSH	B
	CALL	TRKINDX		;compute table index.
;
;compute index into track table
;
	MOV	C,A		;put disk number into reg e.
	MVI	B,0
	LXI	H,TRKTAB	;point to start of trk table
	DAD	B		;get correct drive byte
	POP	B
	MOV	A,M		;get track value
	OUT	TRACK		;force into 1793 track reg.
	POP	PSW		;restore track value
LSSEEK:	CPI	1
	MOV	C,A		;save track in reg c
	MOV	A,B		;get copy of drive and density
	JRNC	SEEKOK		;we are > than track 1?
	ANI	30H		;clear density & side bit
	JMPR	SEEK2		;going to trk < 1
;
SEEKOK:	BIT	6,B		;doing doub sided?
	JRZ	SEEK1		;< > 1, doing single sided
	RRCR	C		;divide track by 2
	JRC	SEEKK1		;side bit set,doing odd trk
	RES	6,B		;reset side bit, doing even trk
SEEKK1:	RES	7,C		;clear msb of track value
SEEK1:	MOV	A,B		;get drive select code
SEEK2:	OUT	WAIT		;select disk and density
	CALL	HDLAY		;delay for side select, drv sel
	MOV	A,D		;get sector number
	OUT	SECTP		;tell the controoller chip
	IN	TRACK		;read 1793 track register
	CMP	C		;is track the same?
	JRZ	SAVTRK		;save track value for next time.
	MOV	A,C		;not same, get new track number
	OUT	DDATA		;seek to track with head load
;
;execute seek command
;
EXECC:	MVI	A,14H+STPRAT+HLAB
EXECC1:	OUT	DCOM		;output disk command
	CALL	HDLAY		;allow head to settle

	IF	DMACNTL
	CALL	SLOOP		;use common polling
	ELSE
	IN	WAIT		;use wait port
	IN	DSTAT		;check disk status
	ENDIF

	ANI	10010000B	;mask out junk bits
	JRZ	SAVTRK		;save track for next time
;
;we have an seek error,
;save primary registers
;and execute a read id.
;
RIDCOM:	EXX			;save regs
	LXI	H,BUFF		;buffer area for read id

	IF	DMACNTL
	LXI	B,RDID SHL 8 OR WCT0
	LXI	D,04006H	;dma read, length
	CALL	DMARW		;read the id marks

	ELSE

	MVI	A,RDID		;read id command
	OUT	DCOM		;send it
	CALL	HDLAY		;settle head delay
RIDLOP:	IN	WAIT		;stall cpu
	ORA	A		;set flags
	JP	RIDDON		;read status if done
	IN	DDATA		;get a byte from floppy
	JMPR	RIDLOP		;loop till done
RIDDON:	IN	DSTAT		;read floppy status
	ENDIF

	ANI	9DH		;any errors in reading?
	JRZ	DENOK		;no, density is correct.
	EXX			;yes, incorrect density
	MOV	A,B		;get density and drive byte
	RES	3,A		;set single density for retry
	OUT	WAIT		;on read id.
	CALL	HDLAY		;head settle time
	JMPR	RIDCOM		;switch registers and retry.
;
DENOK:	IN	SECTP		;get track byte
	OUT	TRACK		;place value into trk reg.
	LDA	SEEKRTY		;get retry count
	DCR	A
	STA	SEEKRTY
	EXX			;restore registers
	JRNZ	SEEK1		;reseek to track
	MVI	A,1		;error code
	ORA	A		;set flags
	RET
;
SAVTRK:	PUSH	B
	CALL	TRKINDX		;get correct index value
	MOV	C,A
	MVI	B,0
	LXI	H,TRKTAB	;point to track table
	DAD	B		;add offset
	IN	TRACK		;get 1793 track
	MOV	M,A		;save in table
	POP	B
	RET
;
;get drive select code from reg b
;and shift it right 4 places for
;use as an index into track table
;
TRKINDX:MOV	A,B
	ANI	30H		;strip side and density
	RAR			;shift
	RAR			;right
	RAR			;four
	RAR			;times
	ANI	0FH		;strip junk bits
	RET
;
;dma read / write routine
;
	IF	DMACNTL
DMARW:	XRA	A		;clear accum
	OUT	CMND		;clear dma chip
	MVI	A,0D0H		;force intrp cmnd (1793)
	OUT	DCOM
	DCX	D		;count = count - 1
	OUTP	E
	OUTP	D		;read/write with length
	INX	D
	DCR	C		;reg -> adr0 port now
	OUTP	L
	OUTP	H		;address for dma set up
	MVI	A,41H		;request chan 0 operation
	OUT	CMND		;tell dma chip
	CALL	HDLD		;check head load bit
	ORA	B		;add in command for floppy
	OUT	DCOM		;send it to floppy
;
;adjust h,l for d,e byte count
;
	MOV	A,D		;get a copy of reg d
	ANI	3FH		;strip command bits
	MOV	D,A		;set up for adjust
	DAD	D		;add it to h,l
;
;general purpose wait routine
;
SLOOP:	IN	DMACHK		;check bit 7
	RLC			;and rotate it left
	JRC	SLOOP		;and loop if carry
	IN	DSTAT		;get status of disk
	RET			; and return it to caller
;
;check for head load bit on in 1793
;
HDLD:	IN	DSTAT		;get status from 1793
	BIT	5,A		;check head load bit
	MVI	A,4		;get head load set bit
	RZ			;return if not loaded
	MVI	A,0		;else, get a zero
	RET			;head is load already
	ENDIF
;
;deblock read routine
;read the selected cp/m sector
;
READB:	MVI	A,1
	STA	READOP		;read operation
	MVI	A,WRUAL
	STA	WRTYPE		;treat as unalloc
	JMP	ALLOC		;to perform the read
;
;deblock write routine
;write the selected cp/m sector
;
WRITEB:	XRA	A		;0 to accumulator
	STA	READOP		;not a read operation
	MOV	A,C		;write type in c
	STA	WRTYPE
	CPI	WRUAL		;write unallocated?
	JRNZ	CHKUNA		;check for unalloc
;
;write to unallocated, set parameters
;
	MVI	A,BLKSIZ/128	;next unalloc recs
	STA	UNACNT
	LDA	SEKDSK		;disk to seek
	STA	UNADSK		;unadsk = sekdsk
	LHLD	SEKTRK
	SHLD	UNATRK		;unatrk = sectrk
	LDA	SEKSEC
	STA	UNASEC		;unasec = seksec
;
;check for write to unallocated sector
;
CHKUNA:	LDA	UNACNT		;any unalloc remain?
	ORA	A
	JRZ	ALLOC		;skip if not
;
;more unallocated records remain
;
	DCR	A		;unacnt = unacnt-1
	STA	UNACNT
	LDA	SEKDSK		;same disk?
	LXI	H,UNADSK
	CMP	M		;sekdsk = unadsk?
	JRNZ	ALLOC		;skip if not
;
;disks are the same
;
	LXI	H,UNATRK
	CALL	SEKTRC		;sektrk = unatrk?
	JRNZ	ALLOC		;skip if not
;
;tracks are the same
;
	LDA	SEKSEC		;same sector?
	LXI	H,UNASEC
	CMP	M		;seksec = unasec?
	JRNZ	ALLOC		;skip if not
;
;match, move to next sector for future ref
;
	INR	M		;unasec = unasec+1
	MOV	A,M		;end of track?
	CPI	CPMSPT		;count cp/m sectors
	JRC	NOOVF		;skip if no overflow
;
;overflow to next track
;
	MVI	M,0		;unasec = 0
	LHLD	UNATRK
	INX	H
	SHLD	UNATRK		;unatrk = unatrk+1
;
;match found, mark as unnecessary read
;
NOOVF:	XRA	A		;0 to accumulator
	STA	RSFLAG		;rsflag = 0
	JMPR	RWOPER		;to perform the write
;
;not an unallocated record, requires pre-read
;
ALLOC:	XRA	A		;0 to accum
	STA	UNACNT		;unacnt = 0
	INR	A		;1 to accum
	STA	RSFLAG		;rsflag = 1
;
;common code for read and write follows
;enter here to perform the read/write
;
RWOPER:	XRA	A		;zero to accum
	STA	ERFLAG		;no errors (yet)
	LDA	SEKSEC		;compute host sector
;
; macro replaced by inline code
;
	ORA	A		;carry = 0
	RAR			;shift right
	ORA	A		;carry = 0
	RAR			;shift right
	STA	SEKHST		;host sector to seek
;
;active host sector?
;
	LXI	H,HSTACT	;host active flag
	MOV	A,M
	MVI	M,1		;always becomes 1
	ORA	A		;was it already?
	JRZ	FILHST		;fill host if not
;
;host buffer active, same as seek buffer?
;
	LDA	SEKDSK
	LXI	H,HSTDSK	;same disk?
	CMP	M		;sekdsk = hstdsk?
	JRNZ	NOMATCH
;
;same disk, same track?
;
	LXI	H,HSTTRK
	CALL	SEKTRC		;sektrk = hsttrk?
	JRNZ	NOMATCH
;
;same disk, same track, same buffer?
;
	LDA	SEKHST
	LXI	H,HSTSEC	;sekhst = hstsec?
	CMP	M
	JRZ	MATCH		;skip if match
;
;proper disk, but not correct sector
;
NOMATCH:LDA	HSTWRT		;host written?
	ORA	A
	CNZ	WRITEHST	;clear host buff
;
;may have to fill the host buffer
;
FILHST:	LDA	SEKDSK
	STA	HSTDSK
	LHLD	SEKTRK
	SHLD	HSTTRK
	LDA	SEKHST
	STA	HSTSEC
	LDA	RSFLAG		;need to read?
	ORA	A
	CNZ	READHST		;yes, if 1
	XRA	A		;0 to accum
	STA	HSTWRT		;no pending write
;
;copy data to or from buffer
;
MATCH:	LDA	SEKSEC		;mask buffer number
	ANI	SECMSK		;least signif bits
	MOV	L,A		;ready to shift
	MVI	H,0		;double count
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	H
;
;hl has relative host buffer address
;
	LXI	D,HSTBUF
	DAD	D		;hl = host address
	LDED	DMAADR		;get/put cp/m data
	LXI	B,128		;length of move
	LDA	READOP		;which way?
	ORA	A
	JRNZ	RWMOVE		;skip if read
;
;write operation, mark and switch direction
;
	MVI	A,1
	STA	HSTWRT		;hstwrt = 1
	XCHG			;source/dest swap
;
;c initially 128, de is source, hl is dest
;
RWMOVE:	LDIR			;fast z-80 block move
;
;data has been moved to/from host buffer
;
	LDA	WRTYPE		;write type
	CPI	WRDIR		;to directory?
	LDA	ERFLAG		;in case of errors
	RNZ			;no further processing
;
;clear host buffer for directory write
;
	ORA	A		;errors?
	RNZ			;skip if so
	XRA	A		;0 to accum
	STA	HSTWRT		;buffer written
	CALL	WRITEHST
	LDA	ERFLAG
	RET
;
WRITEHST:
	JMP	EMPRET		;not used


;
;utility subroutine for 16-bit compare
;hl = .unatrk or .hsttrk, compare with sektrk
;
SEKTRC:	XCHG
	LXI	H,SEKTRK
	LDAX	D		;low byte compare
	CMP	M		;same?
	RNZ			;return if not
;
;low bytes equal, test high 1s
;
	INX	D
	INX	H
	LDAX	D
	CMP	M	;sets flags
	RET
;
;readhst reads the physical disk.
;hstdsk = host disk #, hsttrk = host track #,
;hstsec = host sect #. read "hstsiz" bytes
;into hstbuf and return error flag in erflag.
;
READHST:CALL	SETIO
	CALL	READLS
XITIO:	MVI	A,0
	STA	ERFLAG
	RZ
	CMA
	STA	ERFLAG
	RET

SETIO:	LXI	H,DSKLOG		;get hardware port
	LDA	HSTDSK
	ADD	A
	MOV	E,A
	MVI	D,0
	DAD	D
	INX	H
	MOV	B,M			;disk sel stuff in b
	LDA	HSTSEC
	INR	A			;sector on disk is 1-16
	MOV	D,A
	LDA	HSTTRK
	CALL	SEEKLS
	LXI	H,HSTBUF
	RET
;
;ram storage area
;
BEGDAT	EQU	$		;beginning of data area
DSKLOG:	DS	2		;disk 0 log flag/den
DISKHF:	DS	1		;disk hardware format (1, 2, 3)
DISKHS:	DS	1		;disk/density setting = hardware
TRKTAB:	DS	1		;track table for 4 drives
DIRBF:	DS	128		;scratch directory area
ALL00:	DS	38		;allocation vector 0
CHK00:	DS	42		;check vector 0
SEKDSK:	DS	1		;seek disk number
SEKTRK:	DS	2		;seek track number
SEKSEC:	DS	1		;seek sector number
HSTDSK:	DS	1		;host disk number
HSTTRK:	DS	2		;host track number
HSTSEC:	DS	1		;host sector number
SEKHST:	DS	1		;seek shr secshf
HSTACT:	DS	1		;host active flag
HSTWRT:	DS	1		;host written flag
UNACNT:	DS	1		;unalloc rec cnt
UNADSK:	DS	1		;last unalloc disk
UNATRK:	DS	2		;last unalloc track
UNASEC:	DS	1		;last unalloc sector
RTCNT:	DS	1		;disk retry counter
SEEKRTY:DS	1		;seek retry counter
ERFLAG:	DS	1		;error reporting
RSFLAG:	DS	1		;read sector flag
READOP:	DS	1		;1 if read operation
WRTYPE:	DS	1		;write operation type
DMAADR:	DS	2		;dma address
BUFF:	DS	6		;read id buffer
HSTBUF:	DS	HSTSIZ		;host buffer
	END
