;=======================================================
; Polymorphic Systems "Monitor Root" PROMs
; Disassembled by Martin Eberhard
; 9 July 2016
; From two 2708 EPROMs found on a Polymorphic CPU board
; The EPROMs were labeled as follows:
;    Address    Label
;     400h     35025B v.75
;     800h     35030B v.75
; Written by R. T. Martin
;=======================================================

VERS	equ	75h	;(Page 34) Firmware version number

;=======================================================
;SECTOR FORMAT
;
; 10 bytes 00h
;  1 byte  sector number with msb set
;          OR track number (newly formatted disk???)
;  1 byte  track number
;  256 bytes data
;  2 bytes 16-bit checksum
;
;=======================================================

;--------------------------------------------------------
;Keyboard Port (Page 34)
;-------------------------------------------------------
KBD	equ	18h	;Keyboard input port

;--------------------------------------------------------
;Disk Controller Ports (Reverse-engineered from PC board)
;--------------------------------------------------------

DCBASE	equ	20h	;Disk contrller base I/O address

DISK0	equ	DCBASE+00h	;6852 Status/Control Register 1

			;6852 status bits:
RDA	equ	01h	;Rx Data Available
TDRA	equ	02h	;Tx Data Register Available
DCDN	equ	04h	;active-low DCD
CTSN	equ	08h	;active-low CTS
TUF	equ	10h	;Transmit underflow
RXOVRN	equ	20h	;Receiver overrun
PE	equ	40h	;parity error
IRQ	equ	80h	;Interrupt request

			;Control Register 1 Commands
CR2SEL	equ	0bh	;select Control Reg 2, reset things
CR3SEL	equ	40h	;select Control Reg 3
SYNSEL	equ	80h	;Select sync-code register
IDLE68	equ	0C0h	;no command, select data register
RSET68	equ	0CBh	;reset things, select data register

			;Control Register 2 Commands
CR2RES	equ	18h	;8 bits, no parity (see data sheet)

			;Control Register 2 Commands
CR3RES	equ	0Ch	;Clear status, internal sync,
			;..2-sync chr mode

DISK1	equ	DCBASE+01h	;6852 Data/Control

DISK8	equ	DCBASE+08h	;8255 Port A (output)
			;<1:0> = Unit number
			;0 means no unit selected

DISK9	equ	DCBASE+09h	;8255 Port B (input)
SECMSK	  equ	0Fh	;bits 3:0 are the current sector
TRACK0	  equ	10h	;bit 4 is track 0 detect
WPROT	  equ	20h	;Bit 5 is write protect

DISKA	equ	DCBASE+0Ah	;8255 Port C (control bits)
			;<0> = sector pulse/interrupt
			;      (Mode 1 output)
			;<2> = Enable read/write
			;      (an input until overridden: tristate)
			;<3> = Motor On
			;      (also Mode 1 IBF output)
			;<4> = Enable Write
			;<5> = Enable Read
			;<6> = Direction Select
			;<7> = Step

SIMASK	  equ	  01h		  ;Sector interrupt mask

DISKB	equ	DCBASE+0Bh	;8255 Control 
			;DISKB Commands:
RWDIS	equ	04h	;Port C:2 (enable r/w) off (sect int disable)
RWEN	equ	05h	;Port C:2 (enable R/W) on (sect int enable)
MOTOFF	equ	06h	;Port C:3 (spindle motor) off
MOTON	equ	07h	;Port C:3 (spindle motor) on
WRDIS	equ	08h	;Port C:4 (enable write) off
WREN	equ	09h	;Port C:4 (enable write) on
RDDIS	equ	0Ah	;Port C:5 (enable read) off
RDEN	equ	0Bh	;Port C:5 (enable read) on
STPOUT	equ	0Ch	;Port C:6 low  (step out)
STPIN	equ	0Dh	;Port C:6 high (step in)
UNSTEP	equ	0Eh	;Port C:7 low (cancel step pulse)
STEP	equ	0Fh	;Port C:7 high (step)
INIT82	equ	86h	;initialize 8255:
			;  Group A: Mode 0, output
			;  Group B: Mode 1, input
			;  Port C set up for output on all bits

;------------------------
;Poly88 PROM Entry Points
;------------------------
IORET	equ	64h	;restore regs and return
SAVE	equ	117h	;Front panel Mode Entry Point
DEOUT	equ	3d1h	;print de in hex on screen

;-------------------------------------------------------
;Polymorphic DOS RAM variables
;System 88 Programmers Guide page numbers in parenthesis
;-------------------------------------------------------
TIMER	equ	0C00h	;(91)4-byte RTC timer

WMWH	equ	0c08h	;write to memory wormhole

POS	equ	0c0eh	;(99)Current cursor position
SRA2	equ	0c12h	;(60)Sector pulse interrupt service vector
SRA5	equ	0c18h	;(61)Address of keyboard interrupt routine
SCEND	equ	0c1eh	;(98)Video end address
WH0	equ	0c20h	;(109)Console keyboard in wormhole
WH1	equ	0c24h	;(111)Print a on console screen wormhole

;-------------------------------------------------------
;RAM variables and buffers
;System 88 Programmers Guide page numbers in parenthesis
;-------------------------------------------------------
STACK	equ	1000h	;(85)local stack address

OVRLY	equ	2000h	;(86)2K System Overlay Area
			;    1st 4 bytes are the overlay name
OVENT	equ	2004h	;(86)Overlay entry point

SBUF1	equ	2800h	;(87)Directory area
DIRCSM	equ	SBUF1	;(15)Directory checksum
FDENAM	equ	2801h	;(15)FDE variable-length name
FDELST	equ	280fh	;(15)Start of FDE list

CBUF	equ	2c00h	;(63)Command sector buffer

MUNGP	equ	2d00h	;(88)64-byte scratch area

CMND	equ	2d40h	;(96)64-byte command buffer

MEMTOP	equ	2d80h	;(92)last memory address
KBIP	equ	2d82h	;(67)kbd input buffer 'put' pointer
KBIG	equ	2d84h	;(67)kbd input buffer 'get' pointer
KBEX	equ	2d86h	;(70)addr of kbd postprocessing routine
CMDF	equ	2d88h	;(32)nz means reading from a command file
CMDD	equ	2d89h	;(64)Unit number for active command file
CMDP	equ	2d8ah	;(64)Command file pointer
CMDA	equ	2d8ch	;(65)Next sector disk address
CMDN	equ	2d8eh	;(65)remaining sectors in command file
DONT	equ	2d90h	;(79)nz disables interrupt chrs
SBRK	equ	2d91h	;(76)^Y Flag
SYSRES	equ	2d92h	;(88,93)Drive # of the system drive
PVEC	equ	2d93h	;(76)Address of ^Y processor
UVEC	equ	2d95h	;(77)Address of user-chr processor
UBRK	equ	2d97h	;(77)user-chr flag
SCHR	equ	2d98h	;(78)Front panel mode chr
UCHR	equ	2d99h	;(78)User-chr
ERROR	equ	2d9ah	;(104)Error code
LERR	equ	2d9ch	;(104)Previous error code
JOBST	equ	2d9eh	;(103)exec flags
NDRIVES	equ	2d9fh	;(89) drive number from ?
NFDIR	equ	2da0h	;(94)Drive # of directory in SBUF1
NFCK	equ	2da1h	;(94)SBUF1 directory checksum
MTO	equ	2da2h	;(89)Motor timeout counter
CUNIT	equ	2da3h	;Current unit
TRKTAB	equ	2da4h	;Current track table
U1TRK	equ	2da4h	;Unit 1 current track
U2TRK	equ	2da5h	;Unit 2 current track
U3TRK	equ	2da6h	;Unit 3 current track

;The following scratch block stores the tail end of the FDE

FDEFDA	equ	2da7h	;(95)MUNG1 used for FDE disk address
TRKSCS	equ	2da8h	;sectors to transfer on current track
FDEDNS	equ	2da9h	;(95)MUNG2 used for FDE sector count
FDELA	equ	2dabh	;(95)MUNG3 used for FDE File Load Address
FDESA	equ	2dadh	;(95)MUNG4 used for FDE start address

EXECSP	equ	2dafh	;(92)Stack pointer save
USTATS	equ	2db1h	;(75)UART status
RETRYS	equ	2db2h	;Max retries

SINT	equ	2db3h	;(89)on-sector bailout vector
PRESEC	equ	2db5h	;sector to find during interrupt
			;(one before the one we really want)

OVNM	equ	2db6h	;(72)Byte count for OVNAME
OVNAME	equ	2db7h	;6-byte overlay name buffer (including OV)

OVHL	equ	2dbdh	;(72)Save hl for overlay
OVDE	equ	2dbfh	;(72)Save de for overlay
OVBC	equ	2dc1h	;(72)Save bc for overlay
OVPSW	equ	2dc3h	;(72)Save psw for overlay

ONCE	equ	2dc5h	;(101)System boot flag byte
LUSER	equ	2dc6h	;(103)exec flags
CMPTR	equ	2dc7h	;(96)command pointer
EFLG1	equ	2dc9h	;(102)Exec flags
EIC	  equ	  80h	  ;(36)Exec in control
EERR	  equ	  40h	  ;(35)Error code to process
DBARF	  equ	  20h	  ;(35)Inhibit KILLI calls on errors
			  ;<4:0> default device number etc.
EFLG2	equ	2dcah	;(102)command processing flags

FILE	equ	2dcbh	;(92) 44-byte FCB buffer

ERRCOD	equ	2df7h	;DIO Error code (See page 203)
CURTRK	equ	2df8h	;Current track on current drive
DMAADR	equ	2df9h	;Disk operation DMA address

SECCNT	equ	2dfbh	;Sector count

BUGS	equ	2dfch	;(103)table of error counters
PECNT	equ	BUGS	;bad preamble error count
CECNT	equ	BUGS+1	;checksum error count
VECNT	equ	BUGS+2	;data verify error count

;---------
;Constants
;---------
SYNC	equ	0e6h	;disk sync character
MXRTRY	equ	10	;max retries
DUNIT	equ	1	;default unit
MXUNIT	equ	3	;max unit number
SPT	equ	10	;sectors per track
TPD	equ	35	;tracks per disk
DIRSCS	equ	4	;number of directory sectors

;ASCII

CTRLI	equ	09h	;Control-I
CLRSCN	equ	0Ch	;Polymorphic clear-screen chr
CR	equ	0Dh	;Carriage Return
CTRLW	equ	17h	;Control-W
CTRLY	equ	19h	;Control-Y
CTRLZ	equ	1Ah	;Control-Z
DEL	equ	7Fh	;Delete
CURSOR	equ	7Fh	;Polymorphic cursor character

;=================
;Beginning of code
;=================
	org	400h

;-------------------------------------------------------
;System 88 Jump Table
;System 88 Programmers Guide page numbers in parenthesis
;-------------------------------------------------------
	jmp	COLD	;(115)Initialization
	jmp	WARM	;(115)Warm Start4
	jmp	DIO	;(120)Do Disk IO
	jmp	DHALT	;(121)Halt disk
	jmp	MSG	;(116)Print 0-terminated string
	jmp	ERR	;(130)Error
	jmp	OVRTO	;(131)Invoke overlay, remember prior overlay
	jmp	GOVER	;(131)Invoke overlay
	jmp	RTN	;(133)Return from overlay
	jmp	KILLI	;(117)Kill type-ahead, abort all commands
	jmp	FLUSH	;(117)Flush type-ahead
	jmp	LOOK	;(26,134)Examine disk file
	jmp	RUNR	;(137)Load disk file into memory
	jmp	R1WE	;(139)Read an input line from the user
	jmp	FOLD	;(118)Convert lowercase to uppecase
	jmp	FLIP	;(118)Swap lowercase and uppercase
	jmp	RLGC	;(121)Get input line from user
	jmp	CKDR	;(11,119)Calculate directory checksum
	jmp	IEXEC	;(140)Load and run Exec overlay

VERLOC:	db	VERS	;(80)Version number

;===External Subroutine=======================
;Cold-Start Initialization (115)
;=============================================
COLD:	di
	lxi	sp,STACK	;set up stack

	lxi	h,181ch		;mask most of screen
	shld	SCEND		;Video end address

;Initialize the 8255 in the disk controller

	mvi	a,INIT82	;Group A: Mode 0, output
				;Group B: Mode 1, input
				;Port C set up for output on all bits
	out	DISKB		;8255 Control Word


	xra	a		;Clear outputs
	out	DISK8		;8255 Port A
	out	DISKA		;8255 Port C

;Initialize the 6852 in the disk controller

	mvi	a,CR2SEL	;Clear sync, Tx, Rx, select Control Reg 2
	out	DISK0		;6852 Control Reg 1

	mvi	a,CR2RES	;8 bits, no parity
	out	DISK1		;To 68B52 COntrol register 2

	mvi	a,CR3SEL	;Select Control Register 3
	out	DISK0		;6852 Control Reg 1

	mvi	a,CR3RES	;Clear status, internal sync,
				;..2-sync chr mode
	out	DISK1		;To 6852 Control Register 3

	mvi	a,SYNSEL	;Select sync-code register
	out	DISK0		;6852 Control Reg 1

	mvi	a,SYNC		;Sync code
	out	DISK1		;To 6852 sync code

	mvi	a,IDLE68	;Select Transmit Data Fifo
	out	DISK0		;6852 Control Reg 1

;Clear RAM from 2000h through 31FFh

	lxi	h,2000h		;Beginning of external RAM 
	mvi	a,32h

CLRRAM:	mvi	m,0
	inx	h
	cmp	h
	jnz	CLRRAM

;Initialize RAM variables

	lxi	h,IORET		;Restore regs, EI, ret
	shld	SINT		;on-sector bailout vector
	shld	UVEC		;Address of user-chr processor
	shld	PVEC		;Address of ^Y processor

	mvi	a,MXRTRY	;Set maximum retries
	sta	RETRYS		;Max retries

	mvi	a,0ffh		;All units: unknown track
	sta	U1TRK
	sta	U2TRK
	sta	U3TRK

	lxi	h,KBDGET	;install get kbd chr wormhole
	shld	WH0+1		;The 'call' is already in place

	lxi	h,KBDPPR	;default kbd postprocessing routine
	shld	KBEX		;addr of kbd postprocessing routine

	call	FLUSH		;Flush type-ahead buffer

	mvi	a,CLRSCN	;Clear screen chr
	call	WH1		;Print a on console screen

	mvi	a,CTRLZ		;default to control-Z
	sta	SCHR		;Front panel mode chr

	mvi	a,DUNIT		;default unit
	sta	SYSRES		;Drive # of the system drive

;===External Subroutine=======================
;Warm Start (115)
;=============================================
WARM:	lxi	sp,STACK	;Fix stack

	call	GOVER		;Invoke overlay
	db	'Exec'
	jmp	WARM

;===External Subroutine=======================
;Load and run Exec overlay (140)
;=============================================
IEXEC:	call	OVRTO		;Invoke overlay, remembering prior overlay
	db	'Exec'
	jmp	IORET		;restore regs, EI, ret

;===External Subroutine=======================
; Report Error (130)
; On Entry:
;   de = error code
; Exits via WARM
;=============================================
ERR:	call	KILLI		;Kill type-ahead and abort command
	lxi	h,EFLG1		;Exec flag bits
	mov	a,m
	ani	EERR		;Any pending error codes to process?
	jnz	PERR		;Y: print error message
	mov	a,m		;Clear error codes bit
	ori	EERR		;Set error code bit
	mov	m,a
	xchg			;get error code
	shld	ERROR		;Stash error code
	jmp	WARM		;Warm start
;
; Print error message with address

PERR:	xchg
	shld	LERR		;Previous error code

	lxi	h,ERRMSG	;Error message
	call	MSG		;Print 0-terminated message

	push	h		;Save string address so far
	lhld	ERROR		;Get error code
	xchg			;error address into de
	call	DEOUT		;Print de in hex on screen

	pop	h		;restore string address
	inx	h		;skip 1st null
	call	MSG		;Finish string

;Hang here until rescued by some interrupt

HANG:	jmp	HANG		;Hang here

ERRMSG:	db	CR,'(Error ',0	;this goes before the address
	db	')',0		;this goes after the address

;===External Subroutine=======================
;Kill type-ahead and abort commands (117)
;=============================================
KILLI:	lda	CMDF		;See if command files active
	ora	a
	jz	FLUSH		;n: just Flush type-ahead

	xra	a		;no longer active
	sta	CMDF

	push	h
	lxi	h,CAMSG		;Command abort message
	call	MSG

	di

	db	21h		;lxi h opcode skips over 2 bytes

;===External Subroutine=======================
;Flush type-ahead (117)
;=============================================
FLUSH:	di
	push	h

	lxi	h,KBDINT	;Restore keyboard interrupt
	shld	SRA5		;Address of keyboard interrupt routine

	lxi	h,CMND-1
	shld	KBIP		;kbd input buffer 'put' pointer
	shld	KBIG		;kbd input buffer 'get' pointer
	pop	h

; Fall into KBDPPR to save one byte

;-----------------------------------------
;Default keyboard post-processing routine
;-----------------------------------------
KBDPPR:	ret

;----------------------------
;Command abort message string
;----------------------------
CAMSG:	db	CR,'(Cmdf abort)',0

;===External Subroutine=======================
; Print 0-terminated string (116)
; On Entry:
;   hl=string address
;=============================================
MSG:	mov	a,m		;Get string byte
	ora	a		;Termination?
	rz			;y: done

	call	WH1		;Print a on console screen
	inx	h		;Next
	jmp	MSG

;===External Subroutine========================
;Read an input line from the user (139)
; On Entry:
;   hl = user buffer address
;   de = address of 0-terminated prompt string
;    c = max number of characters
;    b = 0: echo terminating chr
;      = 1: don't echo terminating chr
; On Exit:
;   hl points to last chr in buffer
;   b = length of line read
;==============================================
R1WE:	push	d		;prompt string address
	push	h		;buffer address
	push	b		;chr max and echo control

	xchg
	call	MSG		;print prompt string
	xchg

	mvi	b,0		;echo terminating character

; Fall into RLGC

;===External Subroutine=======================
;Get input line from the user (121)
; On Entry:
;   hl = user buffer address
;   de = address of 0-terminated prompt string
;    c = max number of characters
;    b = 0: echo terminating chr
;      = 1: don't echo terminating chr
;   de,hl,bc are already pushed onto the stack
;=============================================
RLGC:	call	WH0		;Get a character from the user

	cpi	DEL		;delete?
	jz	DODEL		;y: back up

	cpi	18h		;Clear line?
	jz	CLRLIN		;Y: Go clear it

	cpi	CTRLW		;control-W?
	jz	DELNAM		;Delete an entire alphanumeric name

	mov	m,a		;enqueue character
	inx	h		;bump buffer pointer
	inr	b		;bump character count
	cpi	CR		;end of input?
	jz	LINEND

	call	WH1		;Print a on console screen
	cpi	CTRLI		;control-I?
	jnz	RLGC1		;n: ordinary chr

;process ^I

	push	h
	lhld	POS		;Current cursor position
	dcx	h		;back it up
	mvi	m,'?'
	pop	h

RLGC1:	mov	a,b		;character count
	cmp	c		;max characters already?
	jnz	RLGC		;n: continue getting user input

;Fall into LINEND

LINEND:	mov	e,b		;character count
	pop	b
	mov	a,b		;echo terminating character?
	ora	a
	dcx	h		;back up and get
	mov	a,m		;..terminating character		~
	cz	WH1		;Print it if we should

	mov	b,e		;character count
	xthl			;save buffer end, get buffer start

;Fall into HDRET

; Restore hl and de, and return with ints enabled

HDRET:	ei
	pop	h		;hl=buffer end
	pop	d		;restore de
	ret			;done with input

; handle delete character and carry on
DODEL:	call	DELETE		;Delete chr and backup
	jmp	RLGC		;continue getting user input

;---Subroutine------------
; Delete from input buffer
; and back up the cursor
;-------------------------
DELETE:	mov	a,b		;character count
	ora	a		;anything to delete?
	rz			;n: done

	dcr	b		;one less chr
	dcx	h		;backup
	mov	a,m		;what was there?
	cpi	9		;can back up over ^I
	jz	BACKUP

	cpi	' '		;any other control character? 
	rc			;y: can't back over it

BACKUP:	push	h

BUCURS:	mvi	a,CURSOR	;cursor character
	call	WH1		;Print cursor on console screen

	lhld	POS		;Cursor position
	mov	a,l		;at beginning of line?
	ani	3fh		;64-chr lines...
	jz	BUDONE		;y: can't back up

	dcx	h		;back cursor up
	mov	a,m		;look at what was there
	cpi	CURSOR		;was it a cursor?
	jz	BUCURS		;Y: replace cursor

BUDONE:	pop	h
	ret

;---Subroutine----------------
;Clear a line on the screen
; On Entry:
;    b = line character count
; On Exit:
;    b = 0
;-----------------------------
CLRLIN:	mov	a,b		;character count
	ora	a		;any chrs left?
	jz	RLGC		;n: continue getting user input

	call	DELETE		;backup one chr
	jmp	CLRLIN		;and keep deleting

;---Subroutine---------------------
;Delete an entire alphanumeric name
;----------------------------------
DELNAM:	call	DELETE		;back up one chr
	mov	a,b		;any characters left to delete?
	ora	a
	jz	RLGC		;n: continue getting user input

	dcx	h		;look at new ending chr
	mov	a,m
	inx	h
	cpi	'0'		;below 0?
	jc	RLGC		;y: continue getting user input

	cpi	'9'+1		;number
	jc	DELNAM		;y: delete it

	ani	5fh		;Convert to uppercase
	cpi	'A'		;gap character?
	jc	RLGC		;y: continue getting user input

	cpi	'Z'+1		;Apha character?
	jc	DELNAM		;y:delete it
	jmp	RLGC		;n: continue getting user input

;===External Subroutine=============================
;Convert lowercase to uppercase and vice versa (118)
; On Entry:
;   a = character
; On Exit:
;   a = character with inverted case
;===================================================
FLIP:	cpi	'A'		;is it a letter?
	rc			;N: done

	cpi	'Z'+1		;Uppercase letter?
	jm	FCASE		;Y: go flip it

;===External Subroutine=============================
;Convert lowercase to uppecase (118)
; On Entry:
;   a = character
; On Exit:
;   a = uppercase character
;===================================================
FOLD:	cpi	'a'		;lowercase letter?
	rc			;N: done

	cpi	'z'+1		;beyond lowercase?
	rnc			;y: done

FCASE:	xri	20h		;Toggle case bit
	ret


;-----------------------------------------
;Got a control-Y. Handle it unless blocked
;-----------------------------------------
PCTRLY:	lda	EFLG1		;Exec flag bits
	ani	EIC		;Are interrupt characters blocked?
	jnz	IORET		;y: restore regs, EI, ret

	inr	a		;a=1
	sta	SBRK		;set ^Y Flag
	lhld	PVEC		;Address of ^Y processor

;Fall into INTCHR

;---------------------------------------
;Handle a keyboard interrupt chr, unless
;DONT flag blocks them
; On Entry:
;   hl = address of handler
;---------------------------------------
INTCHR:	lda	DONT		;nz disables interrupt chrs
	ora	a		;disabled?
	jnz	IORET		;y: restore regs and return

	call	KILLI		;Kill type-ahead and abort command
	pchl			;go to int chr processor

;------------------------------------------
; Got a user-chr. Handle it unless blocked.
;------------------------------------------
DOUCHR:	lhld	UVEC		;Address of user-chr processor
	sta	UBRK		;user-chr flag
	jmp	INTCHR

DOFP:	lxi	h,SAVE		;Front panel entry point
	jmp	INTCHR		;go to front panel mode if possible

;===ISR===============================
;Keyboard Interrupt Service Routine
; All registers already saved on stack
;=====================================
KBDINT:	in	KBD		;Get keyboard chr
	ora	a		;Anything there?
	jz	IORET		;n: restore regs, EI, ret

	cpi	CTRLY		;Control-Y?
	jz	PCTRLY

	mov	b,a
	lda	SCHR		;Is this the front panel mode chr?
	cmp	b
	jz	DOFP		;y: go to front panel if possible

	lda	UCHR		;user-chr
	cmp	b
	jz	DOUCHR

	lhld	KBIP		;kbd input buffer 'put' pointer
	mov	m,b		;enqueue character
	dcr	l		;bump pointer
	mvi	a,0ffh		;check for wrap the dumb way
	cmp	l
	jnz	KBWRAP		;need to wrap around?
	mvi	l,3fh		;wrap to top

KBWRAP:	lda	KBIG		;kbd input buffer 'get' pointer
	cmp	l		; 0648  bd		=
	jz	IORET		;restore regs and return

	shld	KBIP		;kbd input buffer 'put' pointer
	jmp	IORET		;restore regs and return

;-----------------------------------------
;Wait for interrupt before looking for
;more keyboard or command file characters.
;(If reading form a command file instead
;of the keyboard, then the disk controller
;will interrupt us here.)
;-----------------------------------------
CMDWAT:	pop	h		;chuck return address?
	ei			;ints will wake us up
	hlt			;go to sleep

;------------------------------------------
;Get keyboard character
; Hangs until a kbd chr arrives
; Exits through kbd post processing routine
; On Exit:
;   next kbd chr is in a
;------------------------------------------
KBDGET:	lda	CMDF		;Reading from a command file?
	ora	a		;nz means command file
	jnz	GETCFC		;y: deal with it

	di
	push	h
	lhld	KBIG		;kbd input buffer 'get' pointer
	lda	KBIP		;kbd input buffer 'put' pointer
	cmp	l		;any keyboard chrs waiting?
	jz	CMDWAT		;n: go wait for one

	mov	a,m		;get the next kbd chr
	push	psw		;temp save
	dcr	l		;pump kbd queue pointer
	mvi	a,0ffh		;check for wrap-around
	cmp	l		;..the dumb way
	jnz	KGWRAP

	mvi	l,3fh		;wrap around

KGWRAP:	shld	KBIG		;kbd input buffer 'get' pointer
	pop	psw		;recover kbd chr
	ei
	lhld	KBEX		;addr of kbd postprocessing routine
	xthl			;go post-process the kbd chr
	ret

;-------------------------------------
;Get command file character
;Read from disk into CBUF as necessary
;On Exit:
;   a = chr
;   CMDF = 0 if end of file reached
;-------------------------------------
GETCFC:	push	h

NXTCFC:	lhld	CMDP		;Command file pointer
	mvi	a,(CBUF/256)+1	;end of sector?
	cmp	h
	jz	NXTCFS		;Y: next command file sector

	mov	a,m		;get chr from command file
	inx	h		;bump the command file pointer
	shld	CMDP		;and put it back
	ora	a		;end-of-line marker?
	jz	NXTCFC		;y: next command file character

	pop	h
	ret			;got a character

;Get another command file sector, if any are left

NXTCFS:	lhld	CMDN		;remaining sectors in command file
	mov	a,h		;done yet?
	ora	a
	jnz	CMDSEC		;dumb compare
	ora	l
	jnz	CMDSEC		;n: keep going

	sta	CMDF		;a=0: End of command file
	jmp	CMDWAT		;Wait foranother kbd chr

;Read a command-file sector into CBUF

CMDSEC:	dcx	h		;one fewer command file sectors
	shld	CMDN		;remaining sectors in command file

	lxi	h,CBUF		;Command sector buffer
	shld	CMDP		;Command file pointer

	push	d
	xchg

	lhld	CMDA		;Next sector disk address
	inx	h		;bump it
	shld	CMDA		;..and put it back
	dcx	h		;unbump

	push	b

	mvi	b,1		;Read command
	lda	CMDD		;Drive number for active command file
	mov	c,a		;Unit number
	mvi	a,1		;read 1 sector
	call	DIO		;Do disk I/O

	pop	b
	pop	d
	jnc	CMDWAT		;No disk error: wait again for int

	jmp	ERR		;Report error and warmstart

;===ISR==============================================
;Default sector pulse interrupt service routine
; Registers saved prior to entry
; On Entry:
;    PRESEC = sector to find (This is actually
;    one before the one we want to use for transfer.)
;====================================================
SECINT:	in	DISK9		;Current sector
	ani	SECMSK		;just the sector bits
	mov	b,a		;sector number to b
	lda	PRESEC		;desired sector
	cmp	b		;Correct sector?
	jnz	TSTMTO		;n: wait for another sector

	lhld	SINT		;on-sector bailout vector
	pchl			;go there

;Test for motor timeout and halt if so

TSTMTO:	lxi	h,MTO		;Motor timeout counter
	dcr	m		;bump timer
	cz	DHALT		;halt if timeout

	jmp	IORET		;restore regs and return

;===External Subroutine======================
; Shut down drive (121)
; All regisers preserved
;============================================
DHALT:	push	psw
	mvi	a,0feh		;DHALT error code
	sta	ERRCOD		;remember error code

	mvi	a,0		;dumb way to get a 0
	out	DISK8		;select unit 0 (no unit)

	sta	CUNIT		;Current unit is 0 (none selected)
	sta	MTO		;clear motor timeout counter

	mvi	a,MOTOFF	;Spindle motor off
	out	DISKB		;8255 Port C BSR mode control

	mvi	a,RWDIS		;Disable read/write
	out	DISKB		;8255 Port C BSR mode control

	pop	psw
	ret

;---Subroutine----------------------------
;Save all registers in fixed RAM locations
; Trashes all regs
;-----------------------------------------
SAVALL:	di
	shld	OVHL

	xchg
	shld	OVDE

	push	b
	push	psw
	pop	h
	shld	OVPSW

	pop	h
	shld	OVBC
	ret

;===External Subroutine=========================
;Invoke overlay, remembering prior overlay (131)
;===============================================
OVRTO:	call	SAVALL		;Save all registers

	pop	d		;our return address
	lxi	h,4		;New return address is just
	dad	d		;..past 4-byte overlay name
	push	h

	lhld	OVRLY		;1st 2 bytes of overlay name
	push	h
	lhld	OVRLY+2		;2nd 2 bytes of overlay name
	push	h
	lxi	h,RTN		;create return address for overlay
	push	h

;Fall into DOVRLY

;--------------
;Invoke Overlay
;--------------
DOVRLY:	lxi	h,OVENT		;Overlay entry point
	push	h

;Copy requested overlay name into the overlay name buffer

	lxi	h,OVNAME	;Overlay name buffer
	mvi	c,4		;overlay names are 4 bytes

CPYOLN:	ldax	d		;requested overlay name
	mov	m,a		;overlay name buffer
	inx	d
	inx	h
	dcr	c
	jnz	CPYOLN

;Fall into FNDOVL

;---------------------
;Find an overlay file
;---------------------
FNDOVL:	lxi	h,EFLG1		;Exec flag bits
	mov	a,m
	ori	EIC		;dumb way
	xri	EIC		;..to clear exec-in-control bit
	mov	m,a

;Hunt for requested overlay on disk

	lxi	h,OVRLY		;Current file name
	lxi	d,OVNAME	;Overlay name buffer
	mvi	c,4		;4-byte overlay names

NHUNT:	ldax	d		;compare requested name byte
	cmp	m		;..to file name byte
	jnz	GETNAM		;mismatch: go get the next file name
	inx	d
	inx	h
	dcr	c		;All bytes checked?
	jnz	NHUNT		;n: check another

;Fall into RSTRAL to restore all registers

;---Subroutine------------
; Restore saved regsisters
;-------------------------
RSTRAL:	lhld	OVDE		;recover saved de
	xchg			;and put it back
	lhld	OVPSW		;recover saved psw
	push	h		;on the stack for a sec
	lhld	OVBC		;recover saved bc
	push	h		;also on the stack
	lhld	OVHL		;recover saved hl
	pop	b		;restore bc
	pop	psw		;restore psw
	ret

;---Subroutine--------------------
;Read a 4-byte file name from disk
;---------------------------------
; Set up file control block

GETNAM:	lxi	h,'O'+'V'*256	;'OV' extension
	shld	OVNAME+4
	lxi	h,OVNM		;Overlay name
	mvi	m,4		;Read just 4 bytes
	lda	SYSRES		;Drive # of the system drive
	call	RUNR		;Load disk file into memory
	jc	ERR		;Report any error and warmstart

	jmp	RSTRAL		;Go restore all registers

;===External Subroutine=============================
;Load disk file into memory (137)
; On Entry:
;   de = FDE address
;   hl = address of lookup block
;        (1 byte name length, followed by file name)
;   a = drive number (1-9)
;       msb set means don't check extension
; On Exit:
;   de = error code, if carry is set
;   hl = execution address for file from its FDE
;===================================================
RUNR:	push	psw		;save drive number
	call	LOOK		;Examine disk file
	pop	b		;drive number into b
	rc			;done if error

	push	b		;save drive number
	ldax	d		;FDE flag byte
	ani	1fh		;get name length
	adi	3		;plus the extension plus flags
	mvi	h,0		;16-bit add
	mov	l,a
	dad	d		;hl= address of pointer to FDA
				;(starting disk address)
	lxi	d,FDEFDA		;Start of MUNG scratch area

;Copy 8 bytes from the disk FDE header to scratch area:
;  FDA (Starting disk address)
;  DNS (File sector count)
;  LA  (File load address)
;  SA  (File start address)
;
; hl = address of these FDE bytes
; de = FDEFDA (scratch area) destination

	mvi	c,8

COPHDR:	mov	a,m
	stax	d
	inx	h
	inx	d
	dcr	c
	jnz	COPHDR

	lhld	FDELA		;File load address
	mov	a,h		;is load address 0?
	ora	l
	jnz	DREAD		;Go read file

;------------------------------------------
;Exec Error exit: can't run file (203)
;(the file load at 0 would overwrite PROMs)
;------------------------------------------
	lxi	d,0201h		;Exec Error code
	pop	psw		;unit number
	stc			;Carry to indicate error
	ret

;-----------------------------
;Read File
; On Entry:
;   de = memory address
;   FDEFDA = disk address
;   FDEDNS = sector count
;   top-of-stack = unit number
; On Exit:
;   hl = start address
;-----------------------------
DREAD:	pop	psw		;Unit number and extension flag
	ani	7		;Get just the unit number

	xchg			;memory address to de
	lhld	FDESA		;FDE Start Address
	push	h		;remember start address
	mov	c,a		;Unit number to c
	lhld	FDEFDA		;disk address
	mvi	b,1		;Read command
	lda	FDEDNS		;Sector count
	call	DIO		;Do disk I/O

	pop	h		;start address
	ret

;===External Subroutine======================
;Invoke overlay (46)
;============================================
GOVER:	call	SAVALL		;Save all registers
	pop	d		;address of overlay
	lxi	h,4		;Entry point is 4 bytes in
	dad	d
	push	h		;put entry point on stack
	jmp	DOVRLY		;Invoke overlay

;===External Subroutine======================
;External Command (133)
;Return from overlay
;============================================
RTN:	call	SAVALL		;Save all registers

	pop	h		;Restore overlay name
	shld	OVNAME+2	;2nd 2 characters
	pop	h
	shld	OVNAME		;1st 2 characters
	jmp	FNDOVL		;Go find an overlay

;===External Subroutine=============================
;Examine disk file (134)
; On Entry:
;   hl = address of lookup block
;        (1 byte name length, followed by file name)
;   a = unit number (1-7)
;       msb set means don't check extension
; On Exit:
;   de = FDE directory address
;   de = error code, if carry is set
; hl unchanged
;===================================================
LOOK:	push	h		;Lookup block address
	push	psw		;drive number & flag
	ani	7		;just the unit number
	mov	c,a		;..in c
	lda	NFDIR		;Drive # of directory in SBUF1
	cmp	c		;Same drive?
	jz	LOOKSM		;y: go there

;new drive: invalidate the old one, and read the new directory

	lxi	h,0		;invalidate drive
	xra	a
	sta	NFDIR		;Unit # of directory in SBUF1
	lxi	d,SBUF1		;Directory area
	mvi	b,1		;Read command

	mvi	a,DIRSCS	;Read all directory sectors
	call	DIO		;Do disk I/O
	jc	ERLOOK		;Error? error code in e

LOOKSM:	xra	a		;no longer active
	sta	NFDIR		;Unit # of directory in SBUF1
	call	CKDR		;Calculate directory checksum in a

	lxi	h,DIRCSM	;Directory checksum
	cmp	m		;Checksum matches?
	jnz	ERRCSM		;N: Error exit

	sta	NFCK		;SBUF1 directory checksum
	pop	psw		;recover unit number
	push	psw		;..and put it back
	ani	7		;strip off extension flag
	sta	NFDIR		;Drive # of directory in SBUF1
	lxi	d,FDELST	;Start of FDE list in directory

;Hunt through directory for our desired file
; On Entry:
;   de = pointer to FDE list

FHUNT:	pop	psw		;Unit number
	pop	h		;get lookup block address
	push	h		;..and put it back
	push	psw		;save unit number

	ldax	d		;Get FDE flag byte
	ora	a		;Empty entry = end of list?
	jz	ERRFNF		;y: error, file not found

	jp	NOTDEL		;Deleted entry?

;Skip deleted entry

	ani	1fh		;length of file name
	mov	b,a		;b=name length
	jmp	FDESKP

NOTDEL:	ani	1fh		;length of file name
	mov	b,a		;b=file name length
	mov	a,m		;file name length from lookup block
	ani	1fh		;just the length
	cmp	b		;same length?
	jz	CMPNAM		;y: go check the name

;Skip to next entry

FDESKP:	mov	a,b		;file name length
	adi	0bh		;plus the subsequent bytes
	mvi	h,0		;16-bit add
	mov	l,a
	dad	d
	xchg			;next FDE addess into de
	jmp	FHUNT		;try the next FDE

;Compare the file name
; On Entry:
;    a=file name length
;   de points to the FDE's flag byte

CMPNAM:	mov	c,a		;c counts chrs
	pop	psw		;the drive number also has
	push	psw		;..the extension-check bit
	push	d		;remember beginning of FDE
	ani	80h		;bit 7 is extension-check bit
	jnz	NOEXTC		;Check the extension too?

	inr	c		;2 more bytes to check
	inr	c		;since extensions are 2 bytes

NOEXTC:	inx	h		;next lookup block name byte
	inx	d		;next FDE name byte
	ldax	d		;get FDE name byte
	cmp	m		;compare to lookup block name byte
	jnz	NOMTCH		;nomatch: stop looking

	dcr	c		;byte count
	jnz	NOEXTC		;not done: keep comparing

;Matching name found

	pop	d		;begining of FDE
	pop	psw		;unit number
	pop	h		;lookup block address
	ora	a		;clear carry for success
	ret			;exit subroutine

;Name does not match. Try the next one

NOMTCH:	pop	d		;recover beginnig of FDE
	jmp	FDESKP		;and go skip over this FDE

;--------------------------------------
;File not found error during Look (207)
; Error code  = 0300h
;--------------------------------------
ERRFNF:	mvi	e,00h		;error code low byte

	db	21h		;lxi h opcode skips 2 bytes

;-----------------------------------------
;Checksum error in directory during Look:
;Directory destroyed (207)
; Error code  = 03FFh
;-----------------------------------------
ERRCSM:	mvi	e,0FFh		;FF error code means checksum error

;------------------------
; Exec Error Exit (207)
; e = error code low byte
;------------------------
ERLOOK:	mvi	d,03h		;Look error code high byte
	pop	psw
	pop	h
	stc			;Carry indicates error
	ret

;===External Subroutine======================
; Calculate directory checksum (119)
; On Entry:
;    4 directory sectors are in SBUF1
; On Exit:
;   a=checksum
;============================================
CKDR:	push	h
	push	d
	lxi	h,SBUF1+1	;Skip checksum byte
	xra	a		;initial checksum

CKDLUP:	add	m		;add next byte to checksum
	inx	h		;next address
	mov	d,a		;temp save checksum
	mov	a,h		;checked all bytes?
	cpi	(SBUF1/256)+DIRSCS ;buffer ends at end of page
	mov	a,d		;restore checksum
	jnz	CKDLUP		;n: loop for more

	pop	d
	pop	h
	ret

;===External Subroutine======================
;Perform Disk IO (122)
;On Entry:
; de = memory address
; hl = disk address
; b = disk command:
;    0 = write
;    1 = read
;    2 = verify
;    5 = size???<does not exist>
; c = unit number (1-3)
; a = number of sectors
;On Exit:
;  e = error code
; hl = disk size if b=5
; de = error code, if carry set
; carry set if error
;============================================
DIO:	di
	push	d		;memory address
	push	b		;disk cmd & unit
	push	psw		;sector count
	push	h		;disk address
	ora	a		;0 sectors?
	jz	BADCMD		;Error exit

	sta	DONT		;NZ disables interrupt chrs

	lxi	d,-(SPT*TPD)	;-(total sectors on a disk)
	dad	d		;Illegal disk address?
	jc	BADCMD		;Y: Error exit

	mov	e,a		;sector count to e
	mvi	d,0		;de=sector count
	dcx	d		;de=sector count minus 1
	dad	d		;compute last disk address
	jc	BADCMD		;beyond disk: Error exit

	mov	a,c		;unit number
	cpi	1		;no unit number specified?
	jc	BADCMD		;Error exit

	cpi	MXUNIT+1	;illegal unit number?
	jnc	BADCMD		;y: Error exit

	mov	a,b		;Disk command
	cpi	1		;read?
	jz	DISKOP		;y: go read

	cpi	2		;Verify?
	jz	DISKOP		;y: go do it

	ora	a		;Write?
	jnz	BADCMD		;n: Error exit

;Fall into DISKOP

;-----------------------
;Execute Disk Operation
; On Entry:
;   b = disk command
;      0 = write
;      1 = read
;      2 = verify
;   c=unit number (1-3)
;-----------------------
DISKOP:	lxi	h,SECINT	;default sector pulse routine
	shld	SRA2		;..for sector pulse interrupt

	lxi	h,0		;get the current stack pointer
	dad	sp
	shld	DMAADR		;temp save

;if the spindle motor has timed out, then restart it
;and reselect the unit

	lxi	h,MTO		;Get motor timeout counter
	mov	a,m
	ora	a		;Timeout?
	mvi	m,0fah		;Restart motor timer
	jz	ONMOTR		;Y: deal with motor timeout

;if the desired unit is the current unit (whose motor is
;already on), then go do the disk operation.

	lda	CUNIT		;Current unit
	cmp	c		;the one we want?
	jz	DODIO		;y: go do disk op

;select new unit

	mov	a,c		;requested unit number
	sta	CUNIT		;Current unit
	mvi	a,28h		;short timeout for select
	jmp	SELECT		;Go select new unit

;Turn on the spindle motor for the new unit

ONMOTR:	mov	a,c		;Unit number
	sta	CUNIT		;is the new current unit
	mvi	a,MOTON		;Spindle motor on
	out	DISKB		;8255 Port C BSR mode control
	xra	a		;long timeout

;------------------------
;Select new unit
; On Entry:
;   a = timeout value
;   b = disk command
;   c = unit number (1-3)
;   hl points to MTO
;------------------------
SELECT:	sta	TIMER		;Write 1st RTC timer byte
	mov	d,m		;remember MTO value

	mov	a,c		;new unit number
	out	DISK8		;Select unit

	mvi	a,RWEN		;Enable r/w to disk
	out	DISKB		;8255 Port C BSR mode control
	in	DISK9		;Clears Port B interrupt

;Wait for disk operation to complete or timeout

SUWAIT:	ei			;Hang until interrupt
	hlt

	di
	lda	TIMER		;RTC timer 1st byte
	cpi	3ch		;Did we RTC timeout?
	jc	SUWAIT		;n: keep waiting

	mov	a,m		;Motor timeout value
	adi	5		;5 motor timer ticks?
	cmp	d		;previous value of MTO
	jc	DODIO		;N: okay

	call	DHALT		;halt the disk controller
	jmp	DNRERR		;Disk not ready error exit

;------------------------------------------------------
;Initiate Disk Transfer Operation
; On Entry:
;   b = disk command
;   hl points to MTO
;   top-of-stack = disk address
;   next-on-stack = sector count
;   next-on-stack = start address
;   next-on-stack = high byte = opcode, low byte = unit
; On Exit:
;   b = track number
;------------------------------------------------------
DODIO:	mvi	m,0fah		;Start motor timeout
	xra	a		;error code (no error yet)
	cmp	b		;write command?
	jnz	DODIO2		;N: perform transfer

	in	DISK9
	ani	WPROT		;Write protect?
	jz	DODIO2		;n: perform write transfer

;Write protect error

;--------------------------------
;0105: Disk write protected (123)
;--------------------------------
	mvi	e,5		;error code low byte
	db	21h		;lxi h opcode skips 2 bytes

;---------------------------------------
;0101: Bad disk command parameters (122)
;---------------------------------------
BADCMD:	mvi	e,1		;error code low byte

	db	2eh		;mvi l opcode skips one byte

;----------------------------
;01xx: Disk Error (code in a)
;----------------------------
AERROR:	mov	e,a		;enter here with error code in a

	db	21h		;lxi h opcode skips 2

;--------------------------
;0106: Disk not ready (123)
;--------------------------
DNRERR:	mvi	e,6		;Error code low byte

	mvi	d,1		;error code high byte
	pop	h		;restore all registers
	pop	psw
	pop	b
	xchg
	xthl
	pop	h
	xchg

	xra	a		;enable interrupt chrs
	sta	DONT		;0 enables interrupt chrs
	stc			;carry indicates an error
	ei
	ret

;----------------------------------------------------
; Disk Transfer Routine
; On Entry:
;   top-of-stack = disk address
;   next-on-stack = sector count
;   next-on-stack = start address
;   next-on-stack high byte = opcode, low byte = unit
; On Exit:
;   b = track number
;----------------------------------------------------
DODIO2:	pop	h		;Disk address
	pop	psw		;Sector count
	lxi	d,-SPT		;negative sectors per track
	mvi	b,0ffh		;the next loop goes one extra time

TRKCNT:	inr	b		;count tracks
	dad	d		;subtract a track
	jc	TRKCNT		;not too many: keep going

;On exit from the above loop:
; b = track number
; l = first sector on this track-SPT

NEXTRK:	cpi	SPT+1		;more than a track to transfer?
	jnc	NXTK1		;Y: go transfer the rest of this track

	add	l		;compute sector count for this track
	jm	LASTRK		;all on same track?
	jz	LASTRK		;ditto

	jmp	TKXFER		;Some sectors on another track

NXTK1:	add	l		;a=sector count for this track

;----------------------------------------------------
;Read or write multiple sectors on the current track
; On Entry:
;   a = sector count for this track
;   b = track number
;   l = first sector on this track-SPT
;   top-of-stack high byte = opcode, low byte = unit
;   next on stack = start address
;----------------------------------------------------
TKXFER:	mov	h,a		;h=sector count this track
	mov	a,l		;compute starting sector
	adi	SPT		;sectors per track
	mov	d,a		;d=starting sector for transfer

	sui	SPT+1		;compute sector count for transfer
	cma			;..assuming the rest of the track
	sta	FDEDNS		;FDE sector count

	mov	l,b		;l=track number
	shld	FDELA		;hl=FDE File Load Address (sector:track)

	pop	h		;opcode, Unit
	shld	FDESA		;Start Address

	mov	c,l		;unit
	mov	e,h		;disk opcode

	pop	h		;start address
	call	XFERA		;transfer a sectors

	lda	TRKSCS		;sector count on this track
	add	h		;compute next sector start
	mov	h,a
	push	h		;save h=next sector start
	lhld	FDESA		;Start Address
	push	h
	lhld	FDELA		;File Load Address

	mov	a,h		;remaining sectors
	mov	b,l		;track number
	inr	b		;next track
	mvi	l,100h-SPT	;negative sectors per track
	jmp	NEXTRK		;next track

;---------------------------------------------------
;Transfer to/from last track of entire transfer
; On Entry:
;   a = last sector number
;   b = track number
;   c = unit number
;   l = first sector on this track-SPT
;   top-of-stack high byte = opcode, low byte = Unit
;   next-on-stack = start address
;---------------------------------------------------
LASTRK:	sub	l		;compute sector count
	push	psw		;onto stack

	mov	a,l		;compute first sector
	adi	SPT
	mov	d,a		;d=1st sector number

	pop	psw		;sector count
	pop	h		;opcode, unit
	mov	e,h		;e=disk opcode
	mov	c,l		;c=unit
	pop	h		;hl = start address

; Fall into XFERA and return from there

;----------------------------------
; On-Track Disk transfer Subroutine
; On Entry:
;   a = sector count
;   b = track number
;   c = unit number (1-3)
;   d = 1st sector number
;   e = disk opcode
;  hl = start address
;----------------------------------
XFERA:	sta	TRKSCS		;sector count
	lda	RETRYS		;Max retries

RETRY:	di
	push	psw		;Retries remaining
	push	h		;start address
	push	d
	push	b
	lda	TRKSCS		;sector count on this track
	sta	DONT		;NZ blocks interrupt chrs (weird)
	call	SECXFR		;transfer a sectors
	mov	h,a		;error code
	ora	a		;test for error
	mov	a,b		;track number
	sta	EXECSP		;Stack pointer save location
	pop	b
	pop	d
	jz	WVERFY		;no error: go verify if write

;----------
;Read error
;----------
;Bump the appropriate error counter,
;based on error code in h

	push	d
	mov	e,h		;error code
	lxi	h,BUGS-2	;Error counter table base
	mvi	d,0		;high byte is 0
	dad	d		;add error code
	inr	m		;bump counter
	pop	d
	jnz	NOVFLO		;overflow?
	dcr	m		;y: back up
NOVFLO:

;restart motor timer

	pop	h
	mvi	a,0fah		;Motor timeout value
	sta	MTO		;Restart motor timeout counter

;retry if we can

	pop	psw		;Bump retry count
	dcr	a
	jnz	RETRY		;Try again if we can

;too many retries: abort

	lda	ERRCOD		;recover saved error code
	push	h		;bump sp for upcoming pops
	push	h
	push	h
	push	h
	jmp	AERROR		;error, code in a

;Verify, if write operation

WVERFY:	mov	a,e		;disk opcode
	ora	a		;Write operation?
	jnz	HDRET		;N: restore hl & de, then return

	pop	h		;Start address
	pop	psw		;retry count
	mvi	e,2		;Verify opcode
	jmp	RETRY		;Go verify write

;---Subroutine-----------------------
;Delay for a sector times
; On Entry:
;    a = number of sector times
; All registers preserved
;------------------------------------
SECDEL:	push	b
	push	psw

;Compute end sector number (Use of daa assumes SPT=10.)

	mov	b,a		;number of sectors to wait
	in	DISK9		;Current sector
	ani	SECMSK		;just the sector bits
	add	b		;compute end sector
	daa			;Mod 10
	ani	0fh
	mov	b,a		;into b

	mvi	a,1		;short timeout
	sta	TIMER		;RTC Timer 1st byte

;Wait for sector in b

SECWAT:	ei
	hlt			;wait for interrupt

	di
	in	DISK9		;Current sector
	ani	SECMSK		;Just the sector bits
	cmp	b		;the one we want?
	jz	SWDONE		;Y: carry on

	lda	TIMER		;RTC timer 1st byte
	ora	a		;Timeout?
	jnz	SECWAT		;N: keep waiting

;Drive not ready error

	lhld	DMAADR		;recover original SP
	sphl			;and put it back
	jmp	DNRERR		;Disk not ready error exit

;done

SWDONE:	pop	psw		;restore
	pop	b
	ret

;---Subroutine----------------------------
;Step the head
; On Entry:
;    a = number of steps
;        positive value means step inward
;        negative value means step outward
;-----------------------------------------
STEPA:	ora	a		;Already on track?
	rz			;Y: done

	push	b
	mvi	b,STPIN		;Step-in command
	jp	STEPI		;stepping in?

	dcr	b		;convert to STPOUT command
	cma			;absolute value step count
	inr	a

STEPI:	mov	c,a		;c gets step count
	mov	a,b		;Step in or step out
	out	DISKB		;8255 Port C BSR mode control

	push	h
	lxi	h,MTO		;Motor timeout counter

;Step the head c times

STPLUP:	mvi	m,0fah		;Restart motor timeout timer

	mvi	a,STEP		;Set step bit to step the head
	out	DISKB		;8255 Port C BSR mode control
	dcr	a		;And clear the same bit
	out	DISKB		;8255 Port C BSR mode control

	mvi	a,3		;delay for 3 sector times
	call	SECDEL

	dcr	c		;More steps to do?
	jnz	STPLUP		;Y: go step more

	pop	h		;restore regs
	pop	b
	ret			;on track

;---Subroutine------------------------------------
; Seek, then perform read or write or compare
; On Entry:
;    a = sector count
;    b = track
;    c = unit
;    d = 2st sector number
;    e = opcode (0=write, 1=read, 2=verify)
;   hl = DMA address
; On Exit:
;    a = error code, 0 if none
;    Z set if no errors
;-------------------------------------------------
SECXFR:	push	h		;DMA address
	push	d		;d=sector, e=opcode
	push	b		;b=track c=unit
	push	psw		;sector count

;Compute sector number for the preceeding sector
;and save it for the sector interrupt
;(Use of daa assumes SPT = 10)

	mvi	a,9		;negative 1, mod 10
	add	d
	daa			;do the mod 10
	ani	0fh
	sta	PRESEC		;hunt for prior sector

	mov	d,b		;desired track

	mvi	b,0		;current unit high byte = 0
	lxi	h,TRKTAB-1	;Current track table base address
	dad	b		;offset to selected drive
	mov	a,m		;that drive's current track
	cpi	0ffh		;do we know what track we are on?
	jnz	ONTRAK		;y: no need to restore

;The head on this drive is lost. Step way in, then restore

	mvi	a,TPD		;tracks per disk: inward all the way
	call	STEPA		;Step a tracks

;Step outward until track 0 detected

RSTRLP:	mvi	a,0ffh		;step one track outward
	call	STEPA		;step a tracks

	in	DISK9
	ani	TRACK0		;Track 0 detected?
	jz	RSTRLP		;n: keep stepping

	mvi	m,0		;current track is now 0

ONTRAK:	mov	a,d		;desired track
	sub	m		;compare to current track
	call	STEPA		;step a tracks

	mov	m,d		;new current track for this drive
	mov	a,d
	sta	CURTRK		;remember Current track

;Compute on-sector bail-out vector address from register e
;address = OPTAB + 2*e

	mov	a,e		;opcode
	add	a		;times 2
	mov	e,a
	mvi	d,0
	lxi	h,OPTAB		;base address
	dad	d		;add offset
	mov	e,m		;look up routine address
	inx	h
	mov	d,m		;both bytes
	xchg			;into hl
	shld	SINT		;install on-sector bailout vector

	pop	psw		;sector count on this track
	sta	SECCNT		;Sector count for transfer
	pop	b		;b=track c=unit
	pop	d		;d=sector, e=opcode
	pop	h		;DMA address
	shld	DMAADR		;DMA address for disk operation

	in	DISK9		;Clears Port B interrupt
	mvi	a,0ffh		;remember to wait for interrupt
	sta	ERRCOD		;Error code
	sta	DONT		;NZ disables int chrs

;----------------------------------------------
;Wait for disk operation to complete, then exit
;----------------------------------------------
EXITWT:	ei			;wait for next interrupt
	hlt

	di
	lda	ERRCOD		;recover error code
	inr	a		;need to wait for completion?
	jz	EXITWT		;y: halt & wait

	xra	a
	sta	DONT		;re-enable kbd int chrs
	lda	ERRCOD		;get error code
	ora	a		;any errors?
	ret			;done, Z set if no errors

;---------------------------------------
;On-sector bail out vector address table
;---------------------------------------
OPTAB:	dw	WRITE		;Write
	dw	READ		;Read
	dw	VERIFY		;compare disk data to memory

;----------------------------------------------
;Wait for Transmit register to become available
;----------------------------------------------
TXWAIT:	in	DISK0		;6850 Status
	ani	TDRA		;Tx data register available?
	rnz			;Y: ready

	jmp	TXWAIT		;N: Keep waiting

;-------------------------------------------------
;Initialize for write sector
;Reset the 6852, and return with DMA address in bc
;-------------------------------------------------
WSINIT:	lhld	DMAADR		;DMA address
	mov	b,h		;into bc
	mov	c,l

;Fall into URESET

;--------------
;Reset the 6852
;--------------
URESET:	mvi	a,RSET68	;Reset sync, Tx, Rx
	out	DISK0		;6852 Control Register 1
	mvi	a,IDLE68	;..and release them
	out	DISK0		;6852 Control Register 1 
	ret

;--------------------
;Write sector to disk
;--------------------
WRITE:	call	WSINIT		;Reset 6852, get DMA address into bc
	mvi	a,WREN		;Enable writing to disk
	out	DISKB		;8255 Port C BSR mode control

;Write sector preamble to disk:
;  10 zeros
;  2 sync characters
;  1 byte sector number (msb set)
;  1 byte track number

WSEC:	mvi	l,5		;Write 10 0's

W0LOOP:	call	TXWAIT		;Wait for transmitter to be available
	xra	a		;Transmit a couple 0's
	out	DISK1
	out	DISK1

	dcr	l		;More 0's to write?
	jnz	W0LOOP		;y: Write 'em

	mvi	h,0		;hl=initial checksum = 0
	call	TXWAIT		;Wait for tranmsitter
	mvi	a,SYNC		;Write 2 sync characters
	out	DISK1
	out	DISK1

	call	TXWAIT		;Wait for transmitter to be available

	in	DISK9		;Current sector from hardware
	ani	SECMSK		;Just the sector bits
	ori	80h		;set msb to indicate sector number
	out	DISK1		;Write sector number

	lda	CURTRK		;current track
	out	DISK1		;Write to disk

;Write sector data, computing 16-bit checksum as we go
; On Entry: bc = memory address

	mvi	a,80h		;128 byte-pairs per sector

WDLOOP:	push	psw		;byte-pair cpunt
	call	TXWAIT		;Wait for transmitter
	ldax	b		;Get data
	inx	b		;bump memory pointer
	out	DISK1		;Write data to disk
	mov	e,a		;Save for checksum
	ldax	b		;Get data
	inx	b		;bump pointer
	out	DISK1		;Write data to disk
	mov	d,a		;Save for checksum
	dad	d		;Compute 16-bit checksum
	pop	psw		;byte-pair count
	dcr	a		;bump
	jnz	WDLOOP		;More data?

	call	TXWAIT		;Wait for transmitter
	mov	a,l		;low byte of checksum
	cma			;inverted
	out	DISK1		;Write to disk
	mov	a,h		;high byte of checksum
	cma			;inverted
	out	DISK1		;Write to disk

	lxi	h,SECCNT	;Bump sector count
	dcr	m		;More sectors to write?
	mvi	a,WRDIS		;Disable write
	out	DISKB		;8255 Port C BSR mode control
	jz	OKEXIT		;n: successful exit

	mvi	a,WREN		;Enable write
	out	DISKB		;8255 Port C BSR mode control
	in	DISK9		;Clears Port B interrupt

;Wait for sector pulse before writing

WATSEC:	in	DISKA
	ani	1		;Sector interrupt set?
	jnz	WSEC		;Y: go write the sector
	jmp	WATSEC		;N: Keep waiting

;================
;Disk Error Exits
;================
;-----------------------
;0104: Data Verify Error
;-----------------------
VERERR:	mvi	a,4		;Verify error message
	db	21h		;lxi h opcode skips 2 bytes

;------------------------
;0102: Bad Preamble Error
;------------------------
PREERR:	mvi	a,2		;Bad preamble error message

	pop	b
	db	21h		;lxi h opcode skips 2 bytes

;--------------------
;0103: Checksum error
;--------------------
CSMERR:	mvi	a,3		;checksum error's error message

	push	psw		;save error message
	mvi	a,RDDIS		;Disable read
	out	DISKB		;8255 Port C BSR mode control
	pop	psw		;recover error message
	jmp	EXIT		;Error exit

;---------------------------------------------------------------
;Initialize memory-write wormhole to write to memory (for reads)
;---------------------------------------------------------------
READ:	mvi	l,077h		;'mov m,a' Opcode
	db	11h		;'lxi d' opcode skips 2

;--------------------------------------------------------------
;Initialize memory-write wormhole to compare to memory (verify)
;--------------------------------------------------------------
VERIFY:	mvi	l,0beh		;'cmp m' opcode

	mvi	h,RET		;Return instruction
	shld	WMWH		;set up write to memory "wormhole"

	lhld	DMAADR		;disk operation DMA address
	xchg			;into de

;------------------------------------------
;Read or verify a sector
; On Entry:
;   de = DMA address
;   WMWH set up either to read or to verify
;------------------------------------------
RVLOOP:	call	URESET		;Reset the 6852
	mvi	a,RDEN		;Enable read
	out	DISKB		;8255 Port C BSR mode control
	mvi	a,80h		;128 pairs of bytes/sector
	push	psw		;byte count/2 onto stack

	lxi	h,0		;Initialize checksum
	mov	b,h		;Why do this???
	mov	c,l		;or this???
	in	DISK9		;Clears Port B interrupt

;Wait for sector pulse

SPWAIT:	in	DISKA
	ani	SIMASK		;Sector interrupt set?
	jz	SPWAIT		;N: keep waiting

;---------------------------------------------
;Wait for, and validate the next sector header
;(which should be the one we want)
;---------------------------------------------

;Wait up to 1.436ms for reception of the two byte sync and
;  the first two data bytes (the 6852 is configured for two
;  byte mode). This timing provides the 520us portion of a
;  +660us/-520us index alignment tolerance.
;
;  The following loop is 42 cycles with pre-decrement, so:
;     1.436ms = ((64-1)*42)/1.8432mhz
; 
;  Sync is written starting at 660us after the sector pulse
;  and each byte takes 64us to receive, so:
;     520us = 1436us-(4*64us)-660us

	mvi	c,64		;Timeout loop counter

RDWT1:	dcr	c		;(5) Timeout?
	jz	PREERR		;(10) Y: preamble error abort

	in	DISK0		;(10)6852 Status
	ani	RDA		;(7)Rx data available?
	jz	RDWT1		;(10) Wait for data

;Read the sector preamble

	in	DISK1		;Read disk data 1st byte
	mov	b,a		;hardware-generated sector number
	in	DISK1		;Read disk data 2nd byte
	mov	c,a		;software-generated sector number

;Error if the track number is wrong

	lda	CURTRK		;current track
	cmp	c		;match the track we found?
	jnz	PREERR		;n: Preamble error abort

;????what is this test??????? track number = sector number???
;newly-foramtted disk???

	cmp	b		;match sector number?
	jz	RDWT2		;y: we got our sector

;Error if the sector number is wrong. The sector number
;must have msb set.

	in	DISK9		;Current sector
	ani	SECMSK		;Just the sector bits
	ori	80h		;with the flag bit
	cmp	b		;Correct sector?
	jnz	PREERR		;N: preamble error abort

;----------------------------------
;Read sector data into memory at hl
; On Entry:
;    hl = checksum so far
;    de = desired address
;    top-of-stack = byte-pair count
;----------------------------------
RDWT2:	in	DISK0		;6852 Status register
	ani	RDA		;Rx Data available?
	jz	RDWT2		;N: keep waiting, no timeout

	xchg			;de=checksum, hl=address
	in	DISK1		;Read disk data even byte
	mov	c,a		;
	cmp	a		;clear Z flag
	call	WMWH		;Write a to memory at hl
	jnz	VERERR		;Verify error?

	inx	h
	in	DISK1		;Read disk data odd byte
	mov	b,a		;
	cmp	a		;clear Z flag
	call	WMWH		;Write a to memory at hl
	jnz	VERERR		;verify error?

	inx	h		;next memory address
	xchg			;hl=checksum so far, de=address

	dad	b		;compute 16-bit checksum
	pop	psw		;byte-pair count
	dcr	a		;..gets bumped
	push	psw		;..and put back
	jnz	RDWT2		;Loop through sector data

	pop	psw		;Chuck byte-pair count

;------------------------------
;Get and test 16-bit checksum
; On Entry: hl=checksum of data
;------------------------------
RDWT3:	in	DISK0		;8852 status register 
	ani	RDA		;Rx data available?
	jz	RDWT3		;N: keep waiting, no timeout

	in	DISK1		;Read low byte of checksum
	mov	c,a
	in	DISK1		;Read high byte of checksum
	mov	b,a		;bc=16-bi checksum word
	dad	b		;add to data checksum
	inx	h		;Plus 1 should add up to 0

	mov	a,l		;dumb way to test checksum
	cmp	h		;Checksum ok?
	jnz	CSMERR		;n: checksum error
	ora	a		;Checksum 0?
	jnz	CSMERR		;n: checksum error

	lxi	h,SECCNT	;Remaining sector count
	mvi	a,RDDIS		;Disable read
	out	DISKB		;8255 Port C BSR mode control
	dcr	m		;all sectors done?
	jnz	RVLOOP		;N: do another sector

;Fall into OKEXIT for success

;------------------------
;Succesful disk operation
; On Exit:
;   ERRCOD = 0
;------------------------
OKEXIT:	xra	a		;success: error code = 0

;Fall into EXIT

;--------------------------------
;Disk operation complete
; Error codes on exit (122):
;   0 = all is well
;   2 = bad preamble
;   3 = checksum error
;   4 = data verify error
;--------------------------------
EXIT:	sta	ERRCOD		;remember error code
	lxi	h,IORET		;Restore registers, return
	shld	SINT		;on-sector bailout vector
	pchl			;return

;------------------
;End of actual code
;------------------
	db	0,0,0		;fill unused space with 0
	dw	0,0,0,0,0,0,0,0
	dw	0,0,0,0,0,0,0,0
	dw	0,0

	db	' R T Martin',0	;signature

	end


