;------------------------------------------------------------------
;
;  PROMS82.ASM
;
;  This file is a reconstruction of the source code for the
;  three PROM set found in a Poly-8813 I restored. In the early
;  versions of the 8813, the PROM at 0000h was the standard 4.0
;  Poly monitor and the two PROMs at 0400h and 0800h were the 
;  disk PROMs. Disk PROMs ver 7.5 are an example of this config-
;  uration. With the introduction of the double-density controller,
;  additional code space was required so unused features like tape
;  support were removed from the 4.0 monitor PROM and code for the
;  DD FDC inserted into holes in the monitor PROM. This set of
;  PROMs (ver 8.2) is an example of this later configuration.
;
;  This source file was constructed by starting with the 4.0 
;  monitor PROM source (typed in by Martin Eberhard) and the
;  Disk PROM version 7.5 disassembly by Martin Eberhard. I then
;  disassembled and merged in the differences present in the
;  version 8.2 PROM set.
;
;  Source code for the PROM at 0000h follows the coding style
;  of the original Poly 4.0 monitor. Source code for the PROMs
;  0400h and 0800h follow the coding style of Martin Eberhards's
;  version 7.5 disassembly. The source is compatible with the
;  standard CP/M assembler ASM. This source will not assemble
;  under Exec using Asmb because lower case opcodes are used in
;  2/3 of the file.
;
;  Mike Douglas, January 2018
;
;------------------------------------------------------------------

VERS	equ	82h	;(Page 34) Firmware version number

;-----------------------------------------------------------
;SYSTEM-88 (EXEC) DATA
;  (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

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
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

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

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.

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

;--------------------------------------------------------
;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


;--------------------------------------------------------
;Keyboard Port (Page 34)
;-------------------------------------------------------
KBD	equ	18h	;Keyboard input port

;--------------------------------------------------------
;Single density disk controller equates
;--------------------------------------------------------
;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
;--------------------------------------------------------
DCBASE	equ	20h	;disk controller base I/O address
MTIME	equ	5*50	;motor timeout 5 seconds

DSKSCTL	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	;rransmit 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	;xelect 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

DSKSDAT	equ	DCBASE+01h	;6852 Data/Control

DSKSEL	equ	DCBASE+08h	;8255 Port A (output), drive select
			;<1:0> = Unit number
			;0 means no unit selected

DSKSEC	equ	DCBASE+09h	;8255 Port B (input), sector register
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

DSKCTL	equ	DCBASE+0Ah	;8255 Port C write label
DSKSTAT	equ	DCBASE+0Ah	;8255 Port C read label
			;<0> = Sector pulse interrupt
			;      (Mode 1 interrupt output)
			;<1> = Sector pulse
			;      (Mode 1 input buffer full)
			;<2> = Sector int enable (internal write)
			;      (Mode 1 data strobe input)
			;<3> = Motor On
			;<4> = Enable Write
			;<5> = Enable Read
			;<6> = Direction Select
			;<7> = Step

SIMASK	equ	01h	;sector interrupt mask
SPMASK	equ	02h	;sector pulse mask

DSKCMD	equ	DCBASE+0Bh	;8255 Control 
			;disk control commands:
SINTOFF	equ	04h	;Port C:2 (sector interrupt) off
SINTON	equ	05h	;Port C:2 (sector interrupt) on
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
			;    but some bits forced to input for
			;    mode 1 handshake signals

;--------------------------------------------------------
;DOUBLE DENSITY CONTROLLER EQUATES
;--------------------------------------------------------
DDBUFF	EQU	1000H	;DATA TRANSFER BUFFER
DISKADD	EQU	1FE0H	;SECTOR NUMBER (DISK ADDRESS)
MEMADD	EQU	1FE2H	;MEMORY ADDRESS FOR DATA TRANSFER
UNIT	EQU	1FE4H	;DISK NUMBER (4-7)
SECTS	EQU	1FE5H	;NUMBER OF SECTORS TO TRANSFER
COMMAND	EQU	1FE6H	;COMMAND TO CONTROLLER
STATUS	EQU	1FE7H	;STATUS FROM CONTROLLER
SSIDE	EQU	1FEEH	;ONE OR TWO SIDES 40H = SINGLE SIDED
DDTEST	EQU	1FEFH	;ADDRESS TO CHECK IF DD FDC THERE

;******SYSTEM RAM ALLOCATION******

	ORG	0C00H	;BEGIN ONBD RAM
TIMER:	DS	4	;INCREMENTED BY 60HZ CLOCK
			;LOW BYTE=LEAST SIGNIFICANT
	DS	4	;SKIP UNUSED OLD SYSTEM DATA
WMWH:	DS	4	;WRITE TO MEMORY WORMHOLE
	DS	2	;SKIP UNUSED OLD SYSTEM DATA
POS:	DS	2	;CURSOR POSITION FOR DSPLY

;INTERRUPT SERVICE ROUTINE ADDRESS TABLE

SRA1:	DS	2	;VI7
SRA2:	DS	2	;VI6: SECTOR INTERRUPT
SRA3:	DS	2	;VI5
SRA4:	DS	2	;VI4: USART INT',FIRST INITED SR
SRA5:	DS	2	;VI3: KBD INT.
WAKEUP:	DS	2	;ADDRESS JUMPED TO WHEN CLOCK 
			;OUT IS IN THIS LOC. IT FUNCTIONS
			;EXACTLY LIKE SRA, BUT US ACTUALLY
			;JUMPED TO BY THE CLOCK SOFTWARE.
			;EFFECTIVELY SIMULATES A HARDWARE
			
SRA7:	DS	2	;SINGLE-STEP INTERRUPT. NORMALLY
			;AT ITS INITED ADDR WHICH BRINGS
			;UP FRONT PANEL DISPLAY. IT CAN BE
			;CHANGED FOR EXTERNAL PGMS TO USE FOR
			;DEBUGGING OR FANCY PGMING.
			
;VIDEO SCREEN ADDRESS PARAMETERS USED IN DSPLY.
;INITED TO 1800-1C00 BUT MAY BE CHANGED AFTER
;SYSTEM STARTS UP.

SCEND:	DS	1	;SCREEN END FOR DISPLAY
SCRHM:	DS	1	;SCREEN HOME FOR DOSPLAY

;WORMHOLE VECTOR. THIS TABLE IS FULL OF CALL-RETURN PAIRS
;WHICH CALL SYSTEM I/O PROGRAMS. THEY MAY BE CHANGED 
;INITIALIZATION RO CALL ANY PHYSICAL DEVICE DRIVER IT IS
;DESIRED TO INSTALL. THIS IS NORMALLY DONE WITH LINK PR
;AS DESCRIBED IN MANUALS. THE FIRSTTWO WORMHOLES ARE 
;TO THE SYSTEM CONSOLE KBD AND SYSTEM VIDEO DISPLAY.
;ALL USER I/O SHOULD BE DONE THRU THE WH'S RO INSURE
;COMPATIBILITY WITH ANY SUPERVISOR SYSTEM AND TO ALLOW
;DYNAMIC REASSIGNMENT OF I/O FOR FIXED USER OBJECT PGMS.

WH0:	DS	4	;CONSOLE IN: INITED TO CALL SYS. KBD
WH1:	DS	4	;CONSOLE OUT: INITED TO CALL DSPLY
WH2:	DS	4	;SYSIN: SERIAL IN
WH3:	DS	4	;SYSOT: SERIAL OUT
WH4:	DS	4	;SYSIN2: SECONDARY SYSTEM INPUT.
WH5:	DS	4	;SYSOT2: SECONDARY SYSTEM OUTPUT.
WH6:	DS	4	;READ: TEXT TYPE INPUT USED
			;BY EXTRNL TAPE,DISK,KBD DRIVERS
WH7:	DS	4	;LIST: TEXT TYPE OUTPUT TO LINE
			;PRINTERS OR TEXT FILE ETC.
WH8:	DS	4	;TIMER WORMHOLE (WAS AUXIN)
WH9:	DS	4	;DIO (DISK I/O) WORMHOLE (WAS AUX OUT)

;VCB BLOCKS TO BE TEMPORARILY SWAPPED FOR SCRHM, SCEND AND 
;IN ORDER TO USE DSPLY ON OTHER THAN SYSTEM VIDEO 
;A LINK PGM DOES SWAPPING, AND IS CALLED FROM WH1 IN-
;STEAD OF DSPLY. IT THEN CALLS DSPLY, AND RESTORES
;CONTENTS OF SCRM,SCEND, AND POS BEFORE RET..

VCB2:			;SECONDARY VDO SCRN CONTEXT
SCND2:	DS	1
SCRH2:	DS	1
POS2:	DS	2
VCB3:			;TERTIARY VDO SCRN CTX.
SCND3:	DS	1
SCRH3:	DS	1
POS3:	DS	2

;TEMPORARY LOCATIONS USED BY FRONT PANEL MODE.

WINDOW:	DS	2	;MEM. MODIFY WINDOW POINTER.
SAVPC:	DS	2	;USED BY S.S.WHEN STACK UNAVAILABLE

;***MONITOR PROGRAM***

;VECTOR INTERRUPT LOCATIONS

	ORG	0
RESET:	LXI	SP,STACK
	JMP	INIT	;INIT NOW STARTS IN PROM 3

;THESE TWO INSTRUCTIONS CAN BE CALLED TO GET THE
;ADDDRESS OF THE CALLING PROGRAM INTO H,L.  THIS
;IS NECESSARY IN WRITING SELF RELOCATING CODE.

	POP	H
	PCHL
	
VI6:	PUSH	PSW	;STANDARD REGISTER PUSH SEQUENCE
	PUSH	B
	PUSH	D
	PUSH	H
	LHLD	SRA1	;GET SERVICE ROUTINE ADDRESS
	PCHL		;GO EXECUTE IT. IT WILL RETRN THR
	
VI5:	PUSH	PSW	;SAME AS ABOVE
	PUSH	B
	PUSH	D
	PUSH	H
	LHLD	SRA2
	PCHL
	
VI4:	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	LHLD	SRA3
	PCHL
	
VI3:	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	LHLD	SRA4
	PCHL
	
VI2:	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	LHLD	SRA5
	PCHL
	
CLOCK:	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	JMP	CLKWH	;JUMP THROUGH CLOCK WORMHOLE
	DB	0
	
SS:	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	LHLD	SRA7
	PCHL
	
TIME:	OUT	8	;ENABLE INT FOR NEXT 60HZ CYCLE
	LXI	H,TIMER	;COUNTER LOCATION
	MVI	A,4	;4 BYTES TO INCR
TIME2:	INR	M	;INC ONE LOC.
	JNZ	IORET	;DONE, STANDARD RETURN
	INX	H
	DCR	A
	JNZ	TIME2
	LHLD	WAKEUP	;CNTR IS ZERO, SO INITIATE  WAKEUP
	PCHL		;GO TO THE WAKEUP TASK
	
;USART INTERRUPT: CLEAR THE USART AND EXIT THROUGH IORET

USRTSR:	IN	1
	IN	0
	JMP	IORET
	DB	0,0,0,0,0,0,0,0,0
	
IORET:	POP	H	;THIS CODE SECTION CAN BE JUMPED TO
			;FOR STANDARD SEQ.REG.POPS AND
			;AS FOR ANY INTERRUPT SERVICE RTN
	POP	D
	POP	B
	POP	PSW
	EI
	RET
	
;RESTORE REGISTERS AND DON'T ENABLE INTERRUPTS

IORET2:	POP	H
	POP	D
	POP	B
	POP	PSW
	RET

;RTAB IS A TABLE OF THE 8080 REGISTERS
;AND THEIR RELATIVE POSITION AS
;STORED ON THE STACK

RTAB:	DB	'P',0
	DB	'H',4
	DB	'D',6
	DB	'B',8
	DB	'A',10
	DB	0FFH

;VI1 JUMPS HERE TO JUMP THROUGH THE CLOCK WORMHOLE

CLKWH:	LHLD	WH8	;HL=WORMHOLE 8 VECTOR
	PCHL		;JUMP TO IT
	DB	0

;****** VIDEO DISPLAY DRIVER ******
;
;DSPLY IS THE FAMOUS "TELETYPE SIMULATOR" WHICH
;DRIVES A POLYMORPHICS VTI AND SCROLLS TEXT WHEN
;THE SCRN FILLS.  IT RECOGNIZES ALL IMPORTANT CONTROL
;CHARACTERS AND USES THE SCRHM,SCEND, AND POS LOCATIONS
;IN SYSTEM RAM WHICH ARE INITIALIZED TO GIVE A SCREEN
;AT 1800H TO 1BFFH ON POWER-UP OR RESET.  AT
;THE SAME TIME, ITS OWN ADDRESS IS PUT IN WH1 FOR THE
;DEFAULT SYSTEM CONSOLE DISPLAY DRIVER.

DSPLY:	PUSH	PSW	;A WH PGM MUST SAVE ALL REGS
	PUSH	B
	PUSH	D
	PUSH	H
	LHLD	POS
CTLX	EQU	18H	;ASCII "CAN" CLEARS CUR. LINE
	CPI	CTLX
	JZ	CLINE
	LXI	D,SCRL	;ALL DSPLY CHARACTER
	PUSH	D	;HANDLING SUBROUTINES EXCEPT
			;CLINE RETUEN TO SCRL TO CHECK
			;SCRN OVERFLOW AND SCROLL
			;IF NECESSARY.
	MVI	M,07FH	;BLANK THE CURSOR SO WE
			;WON'T HAVE TO LATER.
			;USE A GRAPHICS BLANK
			;INSTEAD OF A SPACE.
RB	EQU	7FH	;ASCII "DEL" OR RUBOUT
			;BACKSPACE AND DELETE CHAR.
	CPI	RB
	JZ	RBR
	CPI	20H	;IF CHAR IS ABOVE 20H, PRINT IT
	JNC	NORM	;ELSE IT'S NOT A NORMAL CHAR,
			;SO TEST IT FOR VALID CTL CODE
CR	EQU	0DH	;CARRIAGE RETURN. MOVES DOWN
			;A LINE, LEFT-ZEROES CURSOR.
	SUI	CR
	JZ	CRR
FF	EQU	0CH	;FORM FEED. CLEARS SCRN, HOMES
			;CURSOR.
	INR	A
	JZ	FFR
VT	EQU	0BH	;VERTICAL TAB. JUST HOMES CURSOR.
	INR	A
	JZ	VTR
TAB	EQU	09H	;TAB. MOVES CURSOR RIGHT TO
			;NEXT EVEN/8 POSITION.
	INR	A
	INR	A
	RNZ		;IF NOT A TAB, RETURN
	MOV	A,L	;BACK UP CURSOR TO EVEN/8
	ANI	0F8H
	MOV	L,A
	LXI	B,8	;MOVE UP 8 POSITIONS
	DAD	B
	RET
NORM:	ORI	80H	;WE HAVE A PRINTING CHAR, SO MAKE
			;IT INTO CHAR AREA OF VTI SPACE.
	MOV	M,A	;PUT IT IN REFRESH MEM.
	INX	H	;MOVE UP A POSITION.
	RET		;GOTO SCRL.

;SCRL SCROLLS TEXT UP THE SCREEN IF NECESSARY,
;THEN FALLS INTO CURP, WHICH RESTORES THE CURSOR
;AND RETURNS TO USER THRU IORET.

SCRL:	LDA	SCEND
	CMP	H
	JNZ	CURP
	LHLD	SCEND
	MOV	A,H
	SUB	L
	MOV	D,H
	MVI	L,40H
	MVI	E,0
	MOV	C,L
	MOV	B,A
	CALL	MOVE
	DCX	H

;CLINE CLEARS THE CURRENT LINE

CLINE:	MVI	A,3FH
	MOV	D,A
	ORA	L
	MOV	L,A
WIPE:	MVI	M,7FH
	DCX	H
	DCR	D
	JNZ	WIPE
CURP:	MVI	M,0FFH
	SHLD	POS
	JMP	IORET2
RBR:	DCX	H	;RUBOUT ROUTINE
	RET
CRR:	LXI	B,64	;CARRIAGE RETURN RTN.
	MOV	A,L
	ANI	0C0H
	MOV	L,A
	DAD	B
	RET
FFR:	CALL	VTR	;FORM FEED ROUTINE
FF1:	MVI	M,7FH
	INX	H
	CMP	H
	JNZ	FF1
VTR:	LHLD	SCEND	;VERTICAL TAB RTN.
	MOV	A,L
	MVI	L,0
	RET

;MOV MOVES -BC BYTES FROM THE AREA STARTING AT
;(HL) TO THE AREA STARTING AT (DE)

MOVE:	MOV	A,M
	STAX	D
	INX	D
	INX	H
	INX	B
	MOV	A,C
	ORA	B
	JNZ	MOVE
	RET

;****** FRONT PANEL MODE ******
;
;SAVE IS THE ENTRY POINT INTO FRONT PANEL
;MODE IF REGISTERS HAVE BEEN ALREADY PUSHED IN
;STANDARD SEQUENCE.  IT PUSHES PC AND SP
;ON TOP OF REGISTERS FOR DISP TO USE.

SAVE:	LXI	H,10
	DAD	SP
	PUSH	H
	DCX	H
	MOV	D,M
	DCX	H
	MOV	E,M
	JMP	FPWARM	;SKIP NEXT INSTRUCTION

JMPRTC:	JMP	RTCISR	;THIS POINT IN THE PROM (117H) USED
			;TO BE THE "SAVE" ENTRY POINT. NOW IT
			;JUMPS TO THE REAL TIME CLOCK ISR

;FPWARM IS THE ENTRY POINT TO FRONT PANEL MODE
;IF PC AND SP HAVE ALREADY BEEN PUSHED DOWN
;ON TOP OF REGISTERS IN STANDARD SEQUENCE

FPWARM:	PUSH	D	;SAVE DE
	CALL	CLEAR
	EI
	CALL	VTR	;SET HL TO BEGINNING OF SCREEN
	LXI	B,337	;OFFSET FROM SCRHM FOR UPARROW
	DAD	B
	MVI	M,9CH	;VTI CODE FOR UPARROW
	LXI	B,175H	;OFFSET FROM UPARROW FOR
			;RIGHT ARROW
	DAD	B
	MVI	M,9AH	;VTI CODE FOR RIGHT ARROW

;DISP IS THE ENTRY POINT TO FRONT PANEL MODE IF
;THE SCREEN ALREADY SHOWS A FRONT PANEL DISPLAY.
;IT DOES NOT CLEAR THE SCREEN, SO WILL NOT
;BLINK WHEN SCREEN IS UPDATED.

DISP:	MVI	A,CTLX	;ERASE LAST COMMAND ON SCRN
	CALL	WH1
	MVI	A,0BH
	CALL	WH1
	MVI	A,6
	LXI	H,0
	DAD	SP
	LXI	B,FPCMDS  ;BC->STRING OF FRONT PANEL COMMANDS
	PUSH	PSW
DISP1:	STC
	CALL	FLDSY
	CALL	FLDSY
	CALL	BLK
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	CALL	DEOUT
	POP	PSW
	DCR	A
	JZ	FLAGS
	PUSH	PSW
	PUSH	B
	XCHG
	LXI	B,-3
	DAD	B
	XCHG
	CALL	HEXO8
	POP	B
	JMP	DISP1
FPCMDS:	DB	'PCSPHLDEBCAFCMZ'

;FIELD DISPLAY PUTS OUT CHAR IN ADDR IN B IF CY SET.
;IF CY ZERO, PUT BLANK TO VDO DISPLAY.
;IN EITHER CASE, B IS INCREMENTED.

FLDSY:	PUSH	PSW
	CNC	BLK
	LDAX	B
	CC	WH1
	POP	PSW
	INX	B
	RET
FLAGS:	CALL	TABBER
	MOV	A,E
	RRC
	CALL	FLDSY
	RLC
	RLC
	CALL	FLDSY
	RLC
	CALL	FLDSY

;MMOD PLACES THE MEMORY MODIFY DISPLAY
;ON THE SCREEN WINDOW POINT TO THE BYTE
;TO BE MODIFIED

MMOD:	CALL	CROUT
	CALL	CROUT
	LHLD	WINDOW
	LXI	B,-32
	DAD	B
	MVI	C,8
	XCHG
MMOD1:	CALL	DEOUT
	CALL	TABBER
	MVI	A,7FH
	CALL	WH1
	CALL	HEXO8
	DCR	C
	JNZ	MMOD1

;COMD CALLS HEXC TO GET HEX NUMBERS TO BE ENTERED INTO 
;THEN EVALUATES THE NON-HEX TERMINATING CHARACTER TO SEE 
;IF IS A COMMAND

COMD:	CALL	HEXC
	MOV	A,C
	ORA	A
	CNZ	STORE
	MOV	A,B
	LXI 	H,DISP
	PUSH	H
	LXI	H,MTBL
	CALL	LOOKUP
	MVI	D,0
	JNC	ADDIT
	CALL	LOOKUP
	RC
	LXI	H,CMDBAS
	DAD	D
	PCHL

;LOOKUP COMPARES THE ACCUMULATOR
;AGAINST THE ENTRY IN TABLE
;POINTED TO BY HL AND RETURNS WITH
;THE BYTE FOLLOWING IT IN E.
;CARRY FLAG SET IF NO MATCH
;TABLE MUST END IN 0FFH, EACH ENTRY IS 2 BYTES

LOOKUP:	CMP	M
	INX	H
	MOV	E,M
	RZ
	INX	H
	MOV	E,M
	INR	E
	JNZ	LOOKUP
	INX	H
	STC
	RET

;MTBL IS THE TABLE OF COMMANDS FOR
;MEMORY MODIFY

MTBL:	DB	' '	;SPACE MOVES POINTER FORWARD
	DB	17
	DB	8	;BACKSPACE MOVES BACKWARDS ONE
	DB	15
	DB	13	;RETURN MOVES FWD 8 BYTES
	DB	24
	DB	10	;LINE FEED MOVES BACK 8 BYTES
	DB	8
	DB	0FFH	;END OF 1ST HALF TABLE
	DB	'G'	;GO
	DB	G-CMDBAS
	DB	'S'	;SET REGISTER
	DB	SETR-CMDBAS
	DB	'X'	;EXECUTE (SINGLE STEP)
	DB	X-CMDBAS
	DB	'I'	;INDIRECT
	DB	IND-CMDBAS
	DB	'L'	;LOAD MEMORY POINTER
	DB	LOD-CMDBAS
	DB	'J'	;JUMBO - LOAD 2 BYTES
	DB	DOUBLE-CMDBAS
	DB	0FFH

CMDBAS	EQU	$	;COMMAND JUMPS OFFSET FROM HERE

;DETERMINE WHETHER SYSTEM DRIVE (SYSRES) IS SD DRIVE #1 OR
;DD DRIVE #4 AND PLACE IN SYSRES.

SETSYS:	MVI	A,60H	;ENABLE TWIN USER 2
	OUT	04H	;  VIA BRG LATCH
	CALL	CLEAR	;CLEAR SCREEN USER 2

	XRA	A	;ENABLE TWIN USER 1
	OUT	04H	;  VIA BRG LATCH
	CALL	CLEAR	;CLEAR SCREEN USER 1

	MVI	A,CTRLZ	;INIT FRONT PANEL KEY TO CTRL-Z
	STA	SCHR

	LXI	H,DDTEST  ;HL->DD FDC SHARED MEMORY BYTE
	MOV	M,A	;SET TO A VALUE (HAPPENS TO BE CTRL-Z)
	CMP	M	;IS DD FDC THERE? (ZERO TRUE IF SO)

CHKSYS:	MVI	A,1	;A=SINGLE DENSITY CONTROLLER DRIVE #1
	JNZ	SAVSYS	;JUMP TO SAVE SYSTEM DRIVE

	LXI	H,STATUS  ;HL->CONTROLLER STATUS BYTE
	CALL	WAITDD	;WAIT FOR CONTROLLER NOT BUSY
	STA	STATUS	
	JNZ	CHKSYS	;DD CONTROLLER ERROR, SELECT DRIVE #1

	LXI	H,EXECST ;HL->'Exec' FILENAME BLOCK FOR CALL TO LOOK
	MVI	A,84H	;LOOK FOR EXEC.* ON DRIVE 4 (1ST DD DISK)
	CALL	LOOK	;NO CARRY IF FILE FOUND

	MVI	A,1	;ASSUME SD DRIVE IS SYSTEM DRIVE
	JC	SAVSYS	;EXEC NOT ON DRIVE 4, USE SD DRIVE 1

	MVI	A,4	;OTHERWISE, SYSTEM DRIVE IS DD DRIVE 4

SAVSYS:	STA	SYSRES	
	RET

;DOUBLE GETS A HEX NUMBER FROM THE CONSOLE
;AND LOADS IT INTO THE NEXT 2 BYTES IN MEMORY
;(OR A REGISTER) LOW ORDER BYTE FIRST
;J<HEX #>(CR)

DOUBLE:	CALL	HEXC
	XCHG
	LHLD	WINDOW
	MOV	M,E
	INX	H
	MOV	M,D
	RET

;LOD LOADS WINDOW WITH THE NUMBER
;FOLLOWING THE L COMMAND
;L<HEX NUMBER>(CR)

LOD:	CALL	HEXC
SVW:	SHLD	WINDOW
	RET

;ADDIR MOVES THE MEMORY POINTER (WINDOW)
;FORWARD OR BACKWARDS BY
;THE VALUE IN E (D=0)
;E IS OFFSET BY 16

ADDIT:	LHLD	WINDOW
	LXI	B,-16
	DAD	B
	DAD	D
	JMP	SVW

;IND LOADS THE NEXT 2 BYTES IN MEMORY
;INTO WINDOW

IND:	LHLD	WINDOW
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	JMP	SVW

;STORE STORES THE BYTE IN L (ENTERED
;FROM CONSOLE) INTO MEMORY

STORE:	MOV	A,L
	LHLD	WINDOW
	MOV	M,A
	RET

;X EXECUTES ONE INSTRUCTION POINTED TO
;BY SAVPC AND RETURNS TO RST7

X:	POP	H	;2 DUMMY POPS
	POP	H	;GET PC
	SHLD	SAVPC	;SAVE IT
	POP	H
	POP	H	;GET REGISTERS
	POP	D
	POP	B
	POP	PSW
	XTHL		;RESTORE PC
	LHLD	SAVPC
	XTHL
	EI
	OUT	12	;ENABLE SINGLE STEP LOGIC
	RET		;GO TO USER PGM.

;G ACTS THE SAME AS X BUT DOES NOT
;ENABLE SINGLE STEP LOGIC, AND
;THEREFORE DOES NOT RETURN
;TYPING CTL-Z WILL RETURN FROM THE
;PROGRAM BEING EXECUTED AND SAVE
;ALL REGISTERS
;IF A RST7 IS ENCOUNTERED THIS WILL
;ALSO HAPPEN

G:	POP	H
	POP	H
	SHLD	SAVPC
	POP	H
	POP	H
	POP	D
	POP	B
	POP	PSW
	XTHL
	LHLD	SAVPC
	XTHL
	RET

;SETR POINTS TO ONE OF THE 8080 REGISTERS
;AS SAVED IN MEMORY
;MAY BE USED WITH JUMBO COMMAND TO
;SET A REGISTER PAIR, OR WITH OTHER
;COMMANDS TO SET INDIVIDUAL REGISTERS
;S<P/H/D/B/A>

SETR:	CALL	LCFLD	;GET REGISTER DESIGNATION
	LXI	H,RTAB	;AND LOOK UP POSITION
	CALL	LOOKUP
	RC		;RETURN IF NOT VALID REGISTER
	LXI	H,2
	MOV	D,H	;SET D-0
	DAD	SP	;ADD 2 TO STACK POINTER (FOR CALL)
	DAD	D
	JMP	SVW	;PUT WINDOW

;RETURN DISK SIZE IN SECTORS IN HL

DDSKSZ:	POP	PSW	;FIX STACK
	MVI	A,1	;READ 1 SECTOR
	STA	SECTS
	STA	COMMAND	;SET READ COMMAND
	CALL	EXWAIT	;EXCUTE CMD AND WAIT FOR COMPLETION
	LDA	SSIDE	;DOUBLE OR SINGLE SIDED?
	ANI	40H
	LXI	H,77*32	;HL=NUM SECTORS PER SIDE OF 8" DISK
	RNZ		;BIT SET IF SINGLE SIDED

	DAD	H	;DOUBLE SIDED, DOUBLE NUM SECTORS
	RET

;SETUP PUTS IMMEDIATE BYTES INTO BAUD RATE GEN.,
;AND THEN USART CTL PORT.  THE TERM CHAR IS 00H,
;WHICH IS ALSO XMTED TO USART, LEAVING IT IDLING.
;WHEN DONE, JUMPS TO LOC. AFTER
;IMMED BYTES.

SETUP:	POP	H	;GET ADDR FOLLOWING CALL TO SETUP
	MOV	A,M	;GET DATA FOR BRG
	OUT	4	;PUT IN BRG
SET1:	INX	H	;NEXT BYTE
	MOV	A,M
	OUT	1	;USART PORT
	ORA	A	;WAS THAT 00H?
	JNZ	SET1	;NO,NEXT BYTE
	PCHL		;JUMP TO THE 00H, EXEC IT AS A NOP

;DIO FOR DOUBLE DENSITY CONTROLLER

DIODD:	PUSH	H
	LXI	H,DDTEST ;ADDRESS TO CHECK FOR DD FDC
	SHLD	DISKADD	;SAVE AS AN INVALID DISK ADDR FOR LATER
	XRA	A
	MOV	M,A	;WRITE ZERO TO CONTROLLER
	CMP	M	;AND SEE IF IT'S THERE
	POP	H

ERR107:	MVI	A,7	;A=NO DSDD CONTROLLER ERROR
	JNZ	POPERR	;POP AND RETURN ERROR

	MOV	A,C	;DRIVE NUMBER
	STA	UNIT
	MOV	A,B	;I/O COMMAND
	STA	COMMAND
	CPI	5	;DISK SIZE COMMAND?
	JZ	DDSKSZ	;YES, DO DISK SIZE

	SHLD	DISKADD	;SET DISK ADDRESS
	CPI	2	;INITIALIZE COMMAND?
	JZ	DOCMD	;YES, GO EXECUTE A COMMAND

	CPI	4	;EXECUTE 1000H BUFFER COMMAND?
	JZ	DOCMD	;YES, GO EXECUTE A COMMAND

	POP	PSW	;A=NUMBER OF SECTORS TO TRANSFER
	PUSH	PSW
	ORA	A	;ZERO SECTORS SPECIFIED?
	MVI	A,1	;BAD DIO PARAMETER ERROR
	JZ	POPERR	;EXIT WITH ERROR

	POP	PSW	;A=NUMBER OF SECTORS TO TRANSFER

;TRANSFER IN BLOCKS OF 8 SECTORS UNTIL ALL SECTORS TRANSFERRED

XFERLP:	CPI	9	;MORE THAN 8 SECTORS LEFT TO TRANSFER?
	JNC	XFER8	;YES, SO TRANSFER A BLOCK OF 8 SECTORS
	
	CALL	DOXFER	;DO DISK TRANSFER OF 1-8 SECTORS
	JNZ	DIOERR	;EXIT IF ERROR
	
	ORA	A	;ELSE CLEAR CARRY FOR NO ERROR
	RET

XFER8:	SUI	8	;SUBTRACT ANOTHER 8 SECTORS FROM TOTAL
	PUSH	PSW	;SAVE COUNT OF SECTORS LEFT ON STACK
	MVI	A,8	;TRANSFERRING 8 SECTORS
	CALL	DOXFER	;DO THE DISK TRANSFER
	JNZ	POPERR	;EXIT IF ERROR

	MVI	B,0	;FORM BC=8
	MVI	C,8
	LHLD	DISKADD	;INCREMENT DISKADD BY 8 SECTORS
	DAD	B
	SHLD	DISKADD

	POP	PSW	;A=NUMBER OF SECTORS LEFT
	JMP	XFERLP	;REPEAT UNTIL ALL SECTORS DONE
	
;EXECUTE A COMMAND (NO DATA TRANSFER)

DOCMD:	CALL	EXWAIT	;EXECUTE CMD AND WAIT FOR COMPLETION
	JNZ	POPERR	;EXIT IF ERROR

	POP	PSW	;CLEAN UP STACK
	ORA	A	;CLEAR CARRY FOR NO ERROR
	RET

;EXECUTE A DATA TRANSFER OPERATION

DOXFER:	STA	SECTS	;SPECIFY NUMBER OF SECTORS TO TRANSFER
	CMA		;CONVERT TO NEGATIVE BYTE COUNT IN BC
	INR	A
	MOV	B,A
	XRA	A
	MOV	C,A
	
	LDA	COMMAND	;READ OR WRITE?
	ORA	A
	JZ	DSKWRT	;0 COMMAND IS WRITE

	CALL	EXWAIT	;EXECUTE READ AND WAIT FOR COMPLETION
	RNZ		;EXIT IF READ FAILED

	LXI	H,DDBUFF ;HL->DD CONTROLLER TRANSFER BUFFER
	CALL	MOVE	;MOVE FROM DDBUFF TO USER'S BUFFER
	RET

DSKWRT:	XCHG		;HL->USER'S BUFFER
	LXI	D,DDBUFF ;DE->DD CONTROLLER TRANSFER BUFFER
	CALL	MOVE	;MOVE FROMUSER BUFFER TO DDBUFF
	XCHG		;DE->NEXT BYTE IN USER BUFFER
	CALL	EXWAIT	;EXCUTE WRITE AND WAIT FOR COMPLETION
	RET

;EXECUTE DISK I/O: VERIFY CONTROLLER IS READY, SET TRANSFER ADDRESS,
;START TRANSFER, WAIT FOR I/O TO COMPLETE.

EXWAIT:	LXI	H,STATUS  ;HL->DD FDC STATUS
	MOV	A,M	;A=STATUS FROM DD FDC
	ORA	A
	JNZ	DIOEXS	;NOT READY, EXIT WITH STATUS

	PUSH	H	;SET TRANSFER BUFFER TO 1000H
	LXI	H,DDBUFF
	SHLD	MEMADD
	POP	H

	MVI	A,0FFH	;DON'T ALLOW CTRL-Z TO INTERRUPT
	STA	DONT
	MOV	M,A	;SET STATUS TO 0FFH START I/O

;WAIT FOR DD CONTROLLER TO BE NOT BUSY TO INDICATE I/O IS COMPLETE.
;THIS CHECK IS MADE EVERY 660US.

WAITDD:	MVI	A,64	;A=INNER LOOP OF 660US

WTLOOP:	EI		;(4) 19 CYCLE LOOP
	DCR	A	;(5)
	JNZ	WTLOOP	;(10)

	MOV	A,M	;WAIT FOR DD READY FLAG <> FF
	CPI	0FFH
	JZ	WAITDD	;KEEP WAITING
	
	PUSH	PSW	;SAVE STATUS FROM CONTROLLER
	XRA	A	;ALLOW CTRL-Z TO INTERRUPT
	STA	DONT
	POP	PSW	;RESTORE STATUS VALUE
	ORA	A	;TEST FOR ZERO STATUS
			;FALL THROUGH TO SET STATUS TO ZERO
DIOEXS:	MVI	M,0
	RET

POPERR:	POP	H	;CLEAN UP STACK

DIOERR:	MOV	E,A	;E=LSB OF ERROR CODE
	MVI	D,1	;D=MSB OF ERROR CODE
	STC		;FLAG ERROR BY SETTING CARRY
	RET

EXECST:	DB	4,'Exec'

DAAOUT:	DAA
	JMP	WH1	;DISPLAY A ON SCREEN

;***** UTILITY SUBROUTINES *****
;
;THESE SUBROUTINES MAY BE USED EXTERNALLY, SO WE WANT
;THEM IN KNOWN LOCATIONS.
;
;HEXO8 OUTPUTS 8 BYTES FROM THE ADDRESS POINTED
;TO BY D,E LEAVING D,E POMITING TO THE NEXT
;LOCATION IN MEMORY.  IT PUTS THE BYTES OUT
;IN HEX WITH A SPACE BETWEEN THEM AND A
;CARRIAGE RETURN AT THE END OF THE LINE.
;
;D2 IS THE ACTUAL LOOP WHICH HEXO8 USES
;IT PUTS OUT THE NUMBER OF BYTES IN B
;INCRAMENTS D AND THEN PUTS OUT A
;CARRIAGE RETURN.

HEXO8:	MVI	B,8
D2:	CALL	BLK
	LDAX	D
	CALL	BYTE
	INX	D
	DCR	B
	JNZ	D2

;CROUT, CLEAR, BLK, AND TABBER
;OUTPUT A CARIAGE RETURN, FORM FEED, BLANK,
;OR HORIZONTAL TAB TO THE CRT DRIVER, RESPECTIVELY

CROUT:	MVI	A,CR	;PUT CAR RETRN ON CONSLE DSPLY
	JMP	WH1
CLEAR:	MVI	A,12	;CTL-L (FORM FEED)
	JMP	WH1
BLK:	MVI	A,' '	;SPACE
	JMP	WH1
TABBER:	MVI	A,9	;CTL-I TAB
	JMP	WH1

;LCFLD (LOWER CASE FOLD). GETS A CHAR FROM WH0.
;IF AN LC CHAR WAS FOLDED, CY=0,ELSE CY=1.
;WATCH RUBOUTS- THEY'RE FOLDED TO 5FH FROM NORMAL 7FH.

LCFLD:	CALL	WH0	;GET CHAR
	CPI	060H	;IF UPPER CASE,FORGET IT
	RC		;UC LETTERS ARE LESS THAN 60H
	SUI	020H	;FOLD THIS LOWER CASE LETTER ON
	RET

;HEXC INPUTS VARIABLE LENGTH HEX FROM WH0, ECHOING IN 
;TERM CHAR IS ANY NON-HEX CHAR, AND IT IS RETURNED IN B.
;DIGIT COUNT RETURNED IN C.

HEXC:	LXI	H,0	;ZERO CONVERSION BUFFER
	MOV	C,L
NXNYB:	CALL	LCFLD	;GET CASE-FOLDED CHAR FROM WH0
	MOV	B,A	;SAVE THIS CHAR SO IT CAN BE USED IF
			;IT WAS THE TERM CHAR.
	CPI	'0'	;RETURN IF LESS THAN ASCII 0
	RC
	CALL	WH1	;ECHO EACH CHAR. VALID OR NOT
	SUI	'0'	;CHANGE ASCII INTO BINARY 0-15
	CPI	10
	JC	NXNB1
	SUI	7
	CPI	10
	RC		;RETURN IF NOT HEX
	CPI	16
	RNC		;RETURN IF NOT HEX
NXNB1:	INR	C	;COUNT # OF HEX CHARACTERS
	DAD	H	;SHIFT HL
	DAD	H	;OVER
	DAD	H	;FOR NEXT
	DAD	H	;DIGIT
	ORA	L	;OR IN NEW DIGIT
	MOV	L,A
	JMP	NXNYB

;DEOUT OUTPUTS DE TO THE SCREEN
;AS 4 HEX DIGITS

DEOUT:	MOV	A,D
	CALL	BYTE
	MOV	A,E

;BYTE OUTPUTS THE ACCUMULATOR
;AS 2 HEX DIGITS TO THE SCREEN

BYTE:	PUSH	PSW
	RRC
	RRC
	RRC
	RRC
	CALL	HEXO
	POP	PSW

;HEXO OUTPUTS 1 HEX DIGIT TO
;THE SCREEN - THE UPPER HALF
;OF A IS MASKED WITH ZEROS

HEXO:	ANI	15
	ADI	90H
	DAA
	ACI	40H
	JMP	DAAOUT	;DO DAA THEN OUTPUT THROUGH WH0

;****** INITIALIZATION PARAMETERS ******
;THE FOLLOWING BLOCK IS COPIED DIRECTLY OVER
;SYSTEM RAM STARTING AT SRA2.

INITER:	DW	SECINT	;SRA2, VI6 SECTOR INTERUPT
	DW	IORET	;SRA3, VI5
	DW	USRTSR	;SRA4, VI3 USART INTERRUPT
	DW	KBDINT	;SRA5, VI2 KEYBOARD INTERUPT
	DW	IORET	;WAKEUP: NOTHING FOR NOW
	DW	SAVE	;VI0: SINGLE STEP INT GOES BACK
	DB	01CH	;VIDEO SCRN ENDS AT 1C00H-1
	DB	018H	;VIDEO SCRN HOME AT 1800H
	CALL	KBDGET	;WORMHOLE 0: KEYBOARD INPUT
	RET		;STANDARD PART OF ANY WORMHOLE
	CALL	DSPLY	;WORMHOLE1: INIT TO VIDEO DSPLY
	RET

INITL	EQU	$-INITER  ;LENGTH OF INIT TABLE

	DB	47H	;MATCH BYTE IN ORIGINAL PROM

;=======================================================
; START OF 2nd PROM AT 0400h
;=======================================================

;-----------------------------------------------------------
;System 88 Jump Table
;  (System 88 Programmers Guide page numbers in parenthesis)
;-----------------------------------------------------------
VCOLD:	jmp	COLD	;(115)Initialization
	jmp	WARM	;(115)Warm Start4
VDIO:	jmp	WH9	;(122)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)
;=============================================

;Clear system RAM (2000h-2F00h), initialize the 8255 on the
;  single density FDC, set track numbers to unknown for
;  SD drives 1-3.

COLD:	mvi	a,INIT82	;Group A: Mode 0, output
				;Group B: Mode 1, input
				;Port C set up for output on all bits
	out	DSKCMD		;8255 Control Word

	lxi	h,2000h		;HL->start of system RAM to clear 
	mvi	a,2Fh		;clear up to 2F00h

CLRRAM:	mvi	m,0		;zero RAM
	inx	h
	cmp	h		
	jnz	CLRRAM		;clear until 2F00h reached

	xra	a		;Clear outputs
	out	DSKSEL		;8255 Port A (drive select register)
	out	DSKCTL		;8255 Port C (drive control/command)

	dcr	a		;A=FF
 	sta	U1TRK		;track unknown for drives 1-3
	sta	U2TRK
	sta	U3TRK

;Initialize the 6852 on the SD disk controller

	mvi	a,CR2SEL	;Clear sync, Tx, Rx, select Control Reg 2
	out	DSKSCTL		;6852 Control Reg 1

	mvi	a,CR2RES	;8 bits, no parity
	out	DSKSDAT		;To 68B52 Control register 2

	mvi	a,CR3SEL	;Select Control Register 3
	out	DSKSCTL		;6852 Control Reg 1

	mvi	a,CR3RES	;Clear status, internal sync,
				;..2-sync chr mode
	out	DSKSDAT		;To 6852 Control Register 3

	mvi	a,SYNSEL	;Select sync-code register
	out	DSKSCTL		;6852 Control Reg 1

	mvi	a,SYNC		;Sync code
	out	DSKSDAT		;To 6852 sync code

	mvi	a,IDLE68	;Select Transmit Data Fifo
	out	DSKSCTL		;6852 Control Reg 1

;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

	lxi	h,KBDPPR	;default kbd postprocessing routine
	shld	KBEX		;addr of kbd postprocessing routine

	call	FLUSH		;Flush type-ahead buffer

	lxi	h,TIME		;set timer WH8 to jump to TIME
	shld	WH8

	lxi	h,(DIO SHL 8)+CALL ;1st two bytes of CALL DIO
	shld	WH9		;init DIO wormhole 9
	lxi	h,(RET SHL 8)+(DIO SHR 8)  ;MSB of DIO and RET
	shld	WH9+2

	lxi	h,RTCISR	;init jump to real time clock ISR
	shld	SRA1

	call	SETSYS		;set 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:	ei
	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
	
	db	26h		;mvi h opcode skips 1 byte

;===External Subroutine=======================
;Flush type-ahead (117)
;=============================================
FLUSH:	push	h
	di

	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	l	
	jnz	CMDSEC		;no, keep going

	sta	CMDF		;a=0: End of command file
	jmp	CMDWAT		;Wait for another 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
	mov	a,b		;A=number of sectors to read
	call	VDIO		;call DIO through vector

	pop	b
	jc	ERR		;error if carry set

	pop	d
	jmp	CMDWAT		;No disk error: wait again for int

;===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	DSKSEC		;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

	xra	a		;A=0
	out	DSKSEL		;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	DSKCMD		;8255 Port C BSR mode control

	mvi	a,SINTOFF	;Disable sector interrupts
	out	DSKCMD		;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
	ani	(NOT EIC) AND 0FFH  ;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
	jnc	RSTRAL		;Go restore all registers

	mov	a,e		;A=lsb of error code
	sta	2000h		;Store at 2000h (not sure why)
	jmp	ERR		;Report the error

;===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	0Fh		;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	VDIO		;Enter DIO through vector

	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-15)
;       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	0Fh		;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,3		;FIX Read command?

	mvi	a,DIRSCS	;Read all directory sectors
	push	b		;Save command
	call	VDIO		;Call DIO through vector
	pop	b
	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
	jmp	PROM3		;Continue at start of next PROM

	db	9Fh		;match byte in original PROM

;=======================================================
; START OF 3rd PROM AT 0800h
;=======================================================
PROM3:	cmp	m		;Checksum matches?
	jnz	ERRCSM		;N: Error exit

	sta	NFCK		;SBUF1 directory checksum
	mov	a,c		;save the drive number of the
	sta	NFDIR		;  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		;get length of file name alone
	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
	rlc			;bit 7 is extension-check bit
	jc	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

DSKSIZ:	pop	psw
	lxi	h,SPT*TPD	;HL=SD disk size in sectors
	in	DSKSEC		;test for single/double sided
	ral			;msbit is double sided flag
	rnc			;zero msb, single sided

	dad	h		;HL=HL*2 for double sided
	ret

;===External Subroutine======================
;Perform Disk IO (122)
;On Entry:
; de = memory address
; hl = disk address
; b = disk command:
;    0 = write
;    1 = read
;    2 = initialize disk (DD controller only)
;    5 = size
; c = unit number (1-7)
; 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:	push	psw		;save number of sectors
	mov	a,c		;A=drive number
	cpi	4		;single or double density?
	jp	DIODD		;drives 4-7 are double density

	mov	a,b		;A=command
	cpi	5		;disk size?
	jz	DSKSIZ		;yes, return disk size

	ani	1		;limit command to write or read
	mov	b,a		;B=read or write command
	pop	psw

	di
	push	d		;memory address
	push	b		;disk cmd & unit
	push	psw		;sector count
	push	h		;disk address
	
	lxi	d,BADCMD	;DE->BADCMD routine
	push	d		;RETs will jump to BADCMD

	ora	a		;0 sectors?
	rz			;yes, jump to BADCMD

	sta	DONT		;NZ disables interrupt chrs

	lxi	d,-SPT*TPD	;DE= -total sectors on SD disk
	push	psw		;save number of sectors
	in	DSKSEC		;see if double sided
	ral			;msbit 1 for double sided
	jnc	NOTDS		;not double sided
	
	lxi	d,-2*SPT*TPD	;DE= -2*total sectors for DSSD disk

NOTDS:	pop	psw		;restore sector count
	dad	d		;illegal disk address?
	rc			;yes, jump to BADCMD

	mov	e,a		;sector count to D
	mvi	d,0		;DE=sector count
	dcx	d		;DE=sector count minus 1
	dad	d		;compute last disk address
	rc			;beyond disk: jump to BADCMD

	mov	a,c		;unit number
	cpi	1		;valid unit number specified?
	rc			;zero, jump to BADCMD

	cpi	MXUNIT+1	;illegal unit number?
	rnc			;yes, jump to BADCMD

	pop	h		;get rid of BADCMD address
				;Fall into DISKOP

;-----------------------
;Execute Disk Operation
; On Entry:
;   b = disk command
;      0 = write
;      1 = read
;   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,MTIME		;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

	mvi	a,40		;count 40 to 60 = 20*1/60s = 333ms
				;  which is 1.67 revolutions to
				;  ensure index sync has occurred
	jmp	SELECT		;Go select new unit

;Turn on the spindle motor for the new unit

ONMOTR:	mvi	a,MOTON		;Spindle motor on
	out	DSKCMD		;8255 Port C BSR mode control
	xra	a		;count 0 to 60 = 60*1/60 = 1s
				;   motor startup timer

;------------------------
;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	DSKSEL		;Select unit
	sta	CUNIT		;save as current unit

	mvi	a,SINTON	;Enable sector interrupts
	out	DSKCMD		;8255 Port C BSR mode control
	in	DSKSEC		;Clear sector interrupt (Port B)

;Wait for disk operation to complete or timeout

SUWAIT:	ei			;Hang until interrupt
	hlt

	di
	lda	TIMER		;RTC timer 1st byte
	cpi	60		;Did LSB of RTC reach 60?
	jc	SUWAIT		;N: keep waiting

	mov	a,m		;current motor timeout value
	adi	5		;at least 5 sectors go by?
	cmp	d		;compare to starting MTO count
	jc	DODIO		;Y: 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,MTIME		;Start motor timeout
	xra	a		;error code (no error yet)
	cmp	b		;write command?
	jnz	DODIO2		;N: perform transfer

	in	DSKSEC
	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
	
	db	26h		;mvi skips next byte

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
	rc			;exit if error occured

	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
      	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,MTIME		;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 milliseconds specified in A
; On Entry:
;    a = number of ms to delay (1.16ms)
; All registers preserved
;------------------------------------
DLYMS:	ei
	push	b

DLYMS1:	mvi	b,143		;143*15 cycles = 1.16ms/loop
	
DLYMS2:	dcr	b		;(5)
	jnz	DLYMS2		;(10)

	dcr	a		;decrement ms count
	jnz	DLYMS1

	pop	b		;restore BC
	di			;came in with ints disabled
	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	DSKCMD		;8255 Port C BSR mode control

;Step the head c times

STPLUP:	mvi	a,MTIME		;Restart motor timeout timer
	sta	MTO

	mvi	a,STEP		;Set step bit to step the head
	out	DSKCMD		;8255 Port C BSR mode control
	dcr	a		;And clear the same bit
	out	DSKCMD		;8255 Port C BSR mode control

	mvi	a,40		;delay for 40ms
	call	DLYMS

	dcr	c		;More steps to do?
	jnz	STPLUP		;Y: go step more

	mvi	a,10		;delay 10ms for final head settle
	call	DLYMS

	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 preceding 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	DSKSEC
	ani	TRACK0		;Track 0 detected?
	jz	RSTRLP		;n: keep stepping

	mvi	m,0		;current track is now 0

ONTRAK:	mov	a,d		;desired track
	sui	TPD		;subtract tracks per side
	jp	DOSTEP		;track 35-69 now 0-34

	mov	a,d		;else, A=original track 0-34

DOSTEP:	push	psw		;save cylinder
	sub	m		;subtract current cylinder
	call	STEPA		;step a tracks

	pop	psw		;restore cylinder
	mov	m,a		;new current cyclinder for drive
	mov	a,d		;A=original track number
	sta	CURTRK		;remember Current track

	cpi	TPD		;wasted compare?
	mvi	a,STPIN		;A=step in command
	sbi	0		;wasted subtract?
	out	DSKCMD		;idle line at step in

;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	DSKSEC		;Clear sector interrupt (Port B)
	lxi	h,ERRCOD	;HL->ERRCOD
	mvi	a,0FFh		;remember to wait for interrupt
	mov	m,a		;set FF error code
	sta	DONT		;NZ disables int chrs

;----------------------------------------------
;Wait for disk operation to complete, then exit
;----------------------------------------------
EXITWT:	ei			;wait for next interrupt
	hlt

	di
	mov	a,m		;recover error code
	inr	a		;need to wait for completion?
	jz	EXITWT		;y: halt & wait

	xra	a
	sta	DONT		;re-enable kbd int chrs
	mov	a,m		;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	DSKSCTL		;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	DSKSCTL		;6852 Control Register 1
	mvi	a,IDLE68	;..and release them
	out	DSKSCTL		;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	DSKCMD		;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	DSKSDAT
	out	DSKSDAT

	dcr	l		;More 0's to write?
	jnz	W0LOOP		;y: Write 'em

	mov	h,l		;HL=initial checksum = 0
	call	TXWAIT		;Wait for tranmsitter
	mvi	a,SYNC		;Write 2 sync characters
	out	DSKSDAT
	out	DSKSDAT

	call	TXWAIT		;Wait for transmitter to be available

	in	DSKSEC		;Current sector from hardware
	ani	SECMSK		;Just the sector bits
	ori	80h		;set msb to indicate sector number
	out	DSKSDAT		;Write sector number

	lda	CURTRK		;current track
	out	DSKSDAT		;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	DSKSDAT		;Write data to disk
	mov	e,a		;Save for checksum
	ldax	b		;Get data
	inx	b		;bump pointer
	out	DSKSDAT		;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	DSKSDAT		;Write to disk
	mov	a,h		;high byte of checksum
	cma			;inverted
	out	DSKSDAT		;Write to disk

	lxi	h,SECCNT	;Bump sector count
	dcr	m		;More sectors to write?
	mvi	a,WRDIS		;Disable write
	out	DSKCMD		;8255 Port C BSR mode control
	jz	OKEXIT		;n: successful exit

	mvi	a,WREN		;Enable write
	out	DSKCMD		;8255 Port C BSR mode control
	in	DSKSEC		;Clear sector interrupt (Port B)

;Wait for sector pulse before writing

WATSEC:	in	DSKSTAT
	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	DSKCMD		;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,77h		;'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	DSKCMD		;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	DSKSEC		;Clear sector interrupt (Port B)

;Wait for sector pulse

SPWAIT:	in	DSKSTAT
	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.333ms 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 417us portion of a
;  +660us/-417us index alignment tolerance. Note that this
;  is about 100us worse than in the version 7.5 ROM which
;  had a 42 cycle loop instead of 39 cycles.
;
;  The following loop is 39 cycles with a pre-decrement, so:
;     1.333ms = ((64-1)*39)/1.8432mhz
; 
;  Sync is written starting at 660us after the sector pulse
;  and each byte takes 64us to receive, so:
;     417us = 1333us-(4*64us)-660us

	mvi	c,64		;Timeout loop counter

RDWT1:	dcr	c		;(5) Timeout?
	jz	PREERR		;(10) Y: preamble error abort

	in	DSKSCTL		;(10) 6852 Status
	rar			;(4)
	jnc	RDWT1		;(10) Wait for data

;Read the sector preamble

	in	DSKSDAT		;Read disk data 1st byte
	mov	b,a		;hardware-generated sector number
	in	DSKSDAT		;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	DSKSEC		;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	DSKSCTL		;6852 Status register
	ani	RDA		;Rx Data available?
	jz	RDWT2		;N: keep waiting, no timeout

	xchg			;de=checksum, hl=address
	in	DSKSDAT		;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	DSKSDAT		;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	DSKSCTL		;8852 status register 
	ani	RDA		;Rx data available?
	jz	RDWT3		;N: keep waiting, no timeout

	in	DSKSDAT		;Read low byte of checksum
	mov	c,a
	in	DSKSDAT		;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	DSKCMD		;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

;===ISR==============================================
; Real Time Clock interrupt service routine?
; Registers saved prior to entry
;====================================================
RTCBUF	equ	0C54h

RTCISR:	lxi	h,RTCBUF	;HL->real time clock buffer
	in	0F4h		;status register for secs?
	call	RTCCHK		;check and load if changed

	in	0F8h		;status register for mins?
	call	RTCCHK		;check and load if changed

	in	0FCh		;status register for hours?
	call	RTCCHK		;check and load if changed
	jmp	IORET		;exit interupt

RTCCHK:	mov	b,a		;save register value in B
	rrc			;see if lsb cleared
	jnc	RTCNEW		;it is, new value present

	inx	h		;move to next spot in RTCBUF
	inx	h
	ret

RTCNEW:	inr	m		;increment hours, mins, or secs
	inx	h
	mov	m,b		;save register from RTC
	inx	h		;HL->next entry
	ret

INIT:	lxi	d,SRA2		;DE->SRA2 vector
	lxi	h,INITER	;HL->vector init table
	lxi	b,-INITL	;length of init table (negative)
	call	MOVE		;init service vectors
	jmp	VCOLD		;jump to cold start vector

;------------------
;End of actual code
;------------------
	db	0,0,0,0,0,0	;fill unused space with 0

	db	' R T Martin'	;signature
	db	0B9h		;match original PROM

	end


