;	MAPCOPY3
;	REQUIRES DMA CAPABILITIES
;	MAPCOPY3 DIFFERS FROM PREVIOUS RELEASES IN THAT
;	IT DOES NOT COPY TRACK 0, WHICH USED TO DESTROY
;	THE MAPS
	ORG	100H
	JMP	START
;
;
FALSE	EQU	0
TRUE	EQU	NOT FALSE
HSTSPT	EQU	36
NUMHRD	EQU	1	;NUMBER OF HARD DISKS
HEADQ	EQU	6	;NUMBER OF HEADS
D$TRK	DS	2
S$TRK	DS	2
D$SECT	DS	1
S$SECT	DS	1
SOURCE	DS	1
DEST	DS	1
FTRK	EQU	1
CNT	DS	1
PATTERN	DS	1
HSTDSK	DS	1	;0 FOR CART., 1 FOR FIXED
HSTTRK	DS	2	;0 TO 802
HSTSEC	DS	1
HSTBUF	DS	2
TPERR	DS	1
LTRK	EQU	804
SPXFER	EQU	36
CMD	EQU	TRUE
CRLF	EQU	0D0AH
MAPEN	EQU	TRUE
VERIFY	EQU	TRUE
;
UNIT	EQU	0
;
;
	ORG	100H
START	LXI	SP,STACK
	LXI	D,HELOMES
	CALL	PMES
	CALL	CHRIN
	ANI	0FH
	STA	PATTERN
	MVI	A,0
	STA	HSTDSK
	STA	PUNIT
	LXI	D,SORMES
	CALL	PMES
	CALL	CHRIN
	CPI	'T'
	JZ	SZERO
	SUI	30H
	STA	SOURCE
SZERO	STA	SOURCE
	LXI	D,DESMES
	CALL	PMES
	CALL	CHRIN
	CPI	'T'
	JZ	DZERO
	SUI	30H
	STA	DEST
DZERO	STA	DEST
	LXI	D,REDMES
	CALL	PMES
	CALL	CHRIN
	CPI	'Y'
	JNZ	0
	CALL	COPY
	LXI	D,VERMES
	CALL	PMES
	IF	VERIFY
	CALL	QVERIFY
	ENDIF
	LXI	D,COMMES
	CALL	PMES
	JMP	0
;	BUILD SYSTEM MAP
COPY
;	SELECT THE TAPE IN CASE ITS THEIR
	MVI	A,9
	OUT	SEL
;	REWIND IT IF ITS THEIR
	MVI	A,9
	OUT	SEL
	LDA	DEST
	CPI	'T'
	CZ	REWIND
	LDA	SOURCE
	CPI	'T'
	CZ	REWIND
	CALL	SMAPPER
;	INITIALIZE POINTERS
	XRA	A
	STA	HSTDSK
	STA	S$SECT
	STA	D$SECT
	STA	HSTSEC
	LXI	H,FTRK
	SHLD	S$TRK
	SHLD	D$TRK
	SHLD	HSTTRK
;
;
READREC	XRA	A
	STA	CNT
	LDA	SOURCE
	CPI	'T'
	JZ	RTAPE
	STA	HSTDSK
	LXI	H,BIGBUF
	SHLD	HSTBUF
	LHLD	S$TRK
	SHLD	HSTTRK
	LDA	S$SECT
	STA	HSTSEC
REALLP	CALL	READHST
	LDA	HSTBUF+1
	INR	A
	INR	A
	STA	HSTBUF+1
;
	LDA	S$SECT
	MOV	B,A
	LDA	PATTERN
	MOV	D,A	;SAVE PATTERN IN D
	ADD	B
	STA	S$SECT
	SUI	HSTSPT
	JM	DADDD
	INR	A
	STA	S$SECT
	CMP	D	;COMPAIR WITH PATTERN
	JM	DADDD
	XRA	A
	STA	S$SECT
	LHLD	S$TRK
	INX	H
	SHLD	S$TRK
	SHLD	HSTTRK
DADDD	LDA	S$SECT
	STA	HSTSEC
	LDA	CNT
	INR	A
	STA	CNT
	CPI	SPXFER
	JZ	WRITREC
	JMP	REALLP
;
;
WRITREC	XRA	A
	STA	CNT
	LDA	DEST
	CPI	'T'
	JZ	WTAPE
	STA	HSTDSK
	LXI	H,BIGBUF
	SHLD	HSTBUF
	LHLD	D$TRK
	SHLD	HSTTRK
	LDA	D$SECT
	STA	HSTSEC
;
WRTALLP
	CALL	WRITEHST
	LDA	HSTBUF+1
	INR	A
	INR	A
	STA	HSTBUF+1
	LDA	D$SECT
	MOV	B,A
	LDA	PATTERN
	MOV	D,A	;SAVE PATTERN IN D
	ADD	B
	STA	D$SECT
	SUI	HSTSPT
	JM	SADDD
	INR	A
	STA	D$SECT
	CMP	D	;COMPAIR WITH PATTERN
	JM	SADDD
	XRA	A
	STA	D$SECT
	LHLD	D$TRK
	INX	H
	SHLD	D$TRK
	SHLD	HSTTRK
SADDD	LDA	D$SECT
	STA	HSTSEC
	LDA	CNT
	INR	A
	STA	CNT
	CPI	SPXFER
	JNZ	WRTALLP
	LHLD	D$TRK
	LXI	D,-MAXTRK
	DAD	D
	JNC	READREC
;
	RET
QVERIFY
	XRA	A
	STA	S$SECT
	LXI	H,FTRK
	SHLD	S$TRK
	XRA	A
	LDA	DEST
	STA	HSTDSK
	CPI	'T'
	JZ	TVAR
	LHLD	S$TRK
	SHLD	HSTTRK
VERIFYN	LDA	S$SECT
	STA	HSTSEC
	CALL	READINT
	LDA	S$SECT
	MOV	B,A
	LDA	PATTERN
	SUI	1	;RETRY RUNS FASTER THEN COPY
	MOV	D,A	;SAVE PATTERN IN D
	ADD	B
	STA	S$SECT
	SUI	HSTSPT
	JM	VADDD
	INR	A
	STA	S$SECT
	CMP	D
	JM	VADDD
	XRA	A
	STA	S$SECT
	LHLD	S$TRK
	INX	H
	SHLD	S$TRK
	SHLD	HSTTRK
	LXI	D,-MAXTRK
	DAD	D
	RC
VADDD	LDA	S$SECT
	STA	HSTSEC
	JMP	VERIFYN
TVAR	LXI	D,TAPVMES
	JMP	PMES
TAPVMES	DW	CRLF
	DB	'TAPE VERIFIED ON WRITE PASS'
	DB	'$'
;
PMES	MVI	C,9
	JMP	5
CHRIN	MVI	C,1
	JMP	5
CONOUT	PUSH	H
	PUSH	B
	MOV	E,A
	MVI	C,2
	CALL	5
	POP	B
	POP	H
	RET
HELOMES	DW	CRLF
	DB	'KONAN COPY        VERSION 2 REV.A'
	DW	CRLF
	DB	'INTERLACE PATTERN?'
	DB	'$'
SORMES	DW	CRLF
	DB	'ENTER T FOR TAPE, HEAD # FOR DISK '
	DW	CRLF
	DB	'SOURCE?'
	DB	'$'
DESMES	DW	CRLF
	DB	'DESTINITION? '
	DB	'$'
REDMES	DW	CRLF
	DB	'TYPE Y IF READY $'
VERMES	DW	CRLF
	DB	'COPY COMPLETE, BEGIN VERFIY PASS $'
COMMES	DW	CRLF
	DB	'OPERATION COMPLETE $'
TAPEMES	DW	CRLF
	DB	'TAPE CARTRIDGE ERROR $'
MAXTRK	EQU	803
IOBASE EQU 90H
BUSU	EQU	IOBASE
BUSL	EQU	IOBASE+1
CMND	EQU	IOBASE+2
SCTAD	EQU	IOBASE+3
SCTBU	EQU	IOBASE+4
DMACL	EQU	IOBASE+5
DMACU	EQU	IOBASE+6
STATU	EQU	IOBASE+7
WRITEHST:		;ENTRY INTO THE WRITE PROGRAM
	CALL	KCOMMON	;SETS SECTOR,DMA,HEAD,TRACK,UNIT
	RC		;ERROR RETURN
	XRA	A	;CLEAR BUS
	OUT	BUSL
	OUT	BUSU	;BUS IS NOW CLEARED
	OUT	STATU	;SECTOR BUFFER NOW ZEROED
;	WRITE THE HEADER NOW (TRACK MSB,TRACK LSB,HEAD,SECTOR)
	LXI	H,PTRK	;POINT TO THE TRACK
	MVI	B,4	;HEADER BYTE COUNT
HEADWT	MOV	A,M	;GET BYTE IN ACUMULATOR
	OUT	SCTBU	;SEND IT
	INX	H
	DCR	B	;DECREMENT COUNT
	JNZ	HEADWT	;IF NOT DONE JMP TO HEADER WRITE
	MVI	A,02	;DMA WRITE COMMAND
	OUT	CMND	;DO THE WRITE
	OUT	STATU
	MVI	A,1	;DISK WRITE COMMAND
	OUT	CMND	;DO THE WRITE
	CALL	WT	;WAIT FOR IT TO FINISH
	MVI	A,'A'	;ERROR A IS A TIMEOUT
	JC	ERREPORT	;IF TIMEOUT, PRINT A
	IN	STATU	;GET STATU
	ANI	20H	;IS FAULT ON?
	MVI	A,'B'
	JNZ	ERREPORT	;PRINT B IF WRITE FAULT
;REPORT END STATUS
	RET		;DONE WITH WRITE
READHST:	;READ SUBROUTINE.  READS VIA READINT THEN DOES DMA
	CALL	READINT	;PLACE DATA INTO THE SECTOR BUFFER
	MVI	A,04H	;DMA READ COMMAND
	OUT 	CMND	;DO THE READ
	RET		;RETURN
READINT:	;READ TO SECTOR BUFFER
	CALL	KCOMMON	;SET SECTOR,DMA,TRACK,HEAD,AND UNIT
	RC		;ERROR RETURN
	XRA	A	;GENERATE A ZERO
	OUT	BUSL	;CLEAN UP LOWER BUS
	OUT	BUSU	;CLEAN UP UPPER BUS
	STA	CERRC	;ZERO THE ERROR COUNT
RDKON	OUT	STATU	;SET BUFFER TO ZERO
	MVI	A,88H	;DISK READ COMMAND
	OUT	CMND	;DO THE READ
	CALL	WT	;WAIT FOR DONE
	MVI	A,'C'	
	CC	ERREPORT	;PRINT C IF TIMEOUT ERROR
	JC	RCOVRE	;GO ATTEMPT TO RECOVER THE TIMEOUT
	IN	STATU	;GET ENDING STATUS
	ANI	4H	;IS CHECKSUM ON?
	JNZ	CHKRECOV	;GO REPORT/RECOVER
;		WE WILL NOW TEST THE HEADER
	LXI	H,PTRK	;POINT TO THE TRACK
	MVI	B,4	;NUMBER OF HEADER BYTES
	OUT	STATU	;ZERO BUFFER ADDRESS
HDRTST	IN	SCTBU	;GET HEADER READ
	CMP	M
	JNZ	FRMTRCV	;RECOVER IF DIFFERENT
	DCR	B
	INX	H
	JNZ	HDRTST	;IF HEADER COUNT IS NON ZERO TEST ONE MORE
;	WHEN WE ARIVE HERE THE READ IS DONE.
	RET
;
;
;	READ RECOVERY PROGRAM FOLLOWS
CHKRECOV:
	MVI	A,'D'
	CALL	ERREPORT	;PRINT A D IF CHECKSUM ERROR
	JMP	RCOVRE
FRMTRCV	MVI	A,'E'
	CALL	ERREPORT	;PRINT A E IF FORMAT ERROR
RCOVRE:	LDA	CERRC
	INR	A	;INCREMENT THE COUNT
	STA	CERRC	;SAVE THE NEW COUNT
	MOV	C,A	;SAVE THE ERROR COUNT
	ANI	3	;GET LAST 2 BITS,STROBE EARLY AND LATE
	CPI	3	;NOT LEGAL TO HAVE BOTH ON
	JZ	RCOVRE	;IF ILLEGAL, GO TO NEXT CERRC
	MOV	A,C	;GET THE ERROR COUNT
	ANI	18H	;GET THE OFFSET MINUS AND PLUS BITS
	CPI	18H	;ARE THE BOTH ON?
	JZ	RCOVRE	;IF SO GO TO THE NEXT COUNT
	MOV	A,C	;RESTORE THE ERROR COUNT
	CPI	20H	;IS THIS THE START OF THE SECOND PASS?
	CZ	PANIC	;IF 20H WE WILL RETRY SEL,SEEK,MAPPER ETC.
	LDA	CERRC	;RESTORE THE ERROR COUNT
	MOV	C,A	;PLACE IT IN C FOR FUTURE RECALL
	ADI	0DCH	;TIME TO GIVE UP?
	JC	HARDRDER	;IF CARRY WE HAVE A HARD READ ERROR
;	IF WE GET HERE WE ARE READY TO SET RECOVERY BITS AND TRY AGAIN
	MOV	A,C	;RESTORE ERROR COUNT
	RRC		;POSITION BITS
	ANI	8CH	;GET OFFSETS PLUS STROBE EARLY
	OUT	BUSL	;SET THE BITS
	MOV	A,C	;RESTORE ERROR COUNT
	RRC		;POSITION BITS
	ANI	1	;STROBE LATE BIT
	OUT	BUSU	;BUS NOW COMPLETE
	JMP	RDKON	;GO DO THE READ RECOVERY
HARDRDER:		;HARD DISK READ ERROR
	IN	STATU	;SET THE READ BUFFER TO ADDRESS 4
	IN	SCTBU
	IN	SCTBU
	IN	SCTBU
	IN	SCTBU
	MVI	A,'F'	;HARD ERROR
	JMP	ERREPORT
;
;	KONAN DISK READ AND WRITE COMMON ROUTINE
;	SETS THE SECTOR, DMA, UNIT, HEAD, AND TRACK
;	ADDRESSES.  NOTE THAT EVERY HEAD SELECT IS
;	FOLLOWED BY A SEEK TO MAINTAIN COMPATIBILITY
;	WITH CMD DRIVES.
;	RETURNS WITH CARRY SET IF ERROR, RESET IF NOT
;
KCOMMON:
	LHLD	HSTBUF
	MOV	A,L	;GET LSB OF DMA ADDRESS
	OUT	DMACL	;SET LSB OF DMA ADDRESS
	MOV	A,H	;GET MSB OF DMA ADDRESS
	OUT	DMACU	;SET MSB OF DMA ADDRESS
	XRA	A	;MAKE A ZERO
	OUT	BUSL	;CLEAR THE LOWER BUS
	OUT	BUSU	;CLEAR THE UPPER BUS
	CALL	HSTPHY
;
;WE WILL NOW CHECK TO SEE IF SELECT IS TRUE, AND IF THE TRACK
;, HEAD, AND UNIT ADDRESSES ARE THE SAME AS THE LAST TRANSFER,
;STORED IN OLDUNIT, OLDTRK, AND OLDHEAD.
;
	IN	STATU	;GET THE STATUS
	RRC		;PLACE SELECTED BIT INTO CARRY
	JNC	NEWADD	;IF NOT SELECT FORCE NEW ADDRESS
;	TEST NEW VS OLD ADDRESS
	LXI	H,OLDUNIT	;H,L POINT TO OLD ADDRESS
	LXI	D,PUNIT	;D&E POINT TO NEW ADDRESS
	MVI	B,4	;NUMBER OF BYTES TO CHECK
ADCMP	LDAX	D	;GET NEW ADDRESS BYTE
	CMP	M 	;COMPARE IT TO OLD
	JNZ	NEWADD	;IF DIFERENT GO TO NEW ADDRESS
	DCR	B
	INX	H	;INCREMENT THE POINTER TO CURRENT ADDRESS
	INX	D	;INCREMENT THE POINTER TO DESIRED ADDRESS
	JNZ	ADCMP	;IF LOOP IS NOT DONE COMPARE ONE MORE
;	RETURN WITHOUT ERROR, SAME ADDRESS
	XRA	A	;CLEAR CARRY
	RET
NEWADD:
;	SET OLD TO PHYSICAL
	LXI	D,OLDUNIT
	LXI	H,PUNIT
	MVI	B,4	;COUNT
UPDATE	MOV	A,M	;GET NEW
	STAX	D	;UPDATE OLD
	INX	D
	INX	H
	DCR	B
	JNZ	UPDATE
	LDA	PUNIT	;GET THE PHYSICAL UNIT
	RRC		;UNIT IS UPPER HALF OF BYTE
	RRC
	RRC
	RRC
	OUT	BUSU	;PLACE IT ON THE BUS
	MVI	A,10H	;SELECT COMMAND
	OUT	CMND	;SELECT I
	IN	STATU	;GET STATUS
	RRC		;PLACE SELECT IN CARRY
	CMC		;CARRY 1 IF NOT SELECTED
	MVI	A,'G'	;SELECT ERROR
	JC	ERREPORT	;PRINT IT
	LDA	PHEAD	;
	IF	CMD
	CPI	0
	JZ	HDJUST
	ADI	15
	ENDIF
HDJUST	OUT	BUSL	;SET IT ON THE BUS
	MVI	A,40H	;SET HEAD COMMAND
	OUT	CMND	;DO THE HEAD SELECT
	IN	STATU	;GET THE STATUS
	ANI	20H	;TEST DISK FAULT BUT
	MVI	A,'H'
	JNZ	ERREPORT	;IF FAULT IS ONE, REPORT IT
;
;
;	SEEK ROUTINE
;	TRACK SUBSTITUTION INCLUDED
;
SEEK:	CALL	GSEEK	;GO PERFORM THE SEEK
	RNC		;RETURN IF SEEK WAS GOOD(NO CARRY)
;	IF HERE, FIRST SEEK ATTEMPT FAILED
	CALL	RECAL	;RECAL DRIVE TO ATTEMMPT TO CLEAR ERROR
	CALL	GSEEK	;GIVE IT ONE MORE TRY
	RNC		;IF NO ERROR IT RECOVERED
;	IF HERE, HARD SEEK ERROR OCCURED
	MVI	A,0FFH	;SET A TO ALL ONES
	STA	OLDUNIT	;THIS WILL CAUSE A SELECT AND SEEK UPON
;			NEXT ACCESS
	MVI	A,'I'
	JMP	ERREPORT	;REPORT THE SEEK ERROR
GSEEK:	
;	COMPRIZE COMMPOSITE ADDRESS TO SEARCH TRACK TABLE FOR
	LDA	PTRK
	MOV	H,A
	LDA	PTRK+1
	MOV	L,A
	XCHG		;NOW D&E ARE THE TRACK
	IF	MAPEN	;MAP THE TRACK IF MAP IS ENABLED
	LDA	PHEAD	;GET THE HEAD NUMBER
	RLC
	RLC		;PLACE HEAD IN BITS 5-2
	ANI 	1CH	;STRIP ANY ENTRA JUNK
	ORA	D	;OR IN MSB OF TRACK
	MOV 	D,A
	LDA	PUNIT	;GET UNIT NUMBER
	RRC
	RRC
	RRC		;UNIT NOW IN 6-4
	ANI	60H
	ORA	D	;OR HEAD TO UNIT/TRACK
	MOV	D,A	;D IS NOW HEAD,UNIT,TRACKMSB
	MVI	C,0	;SET B,C,TABLE ENTRY PIONTER, TO ZERO
FINDT	LXI	H,SUBTBL	;H&L NOW POINT TO THE TABLE
FINDN	MOV	A,M	;GET BYTE FORM THE TABLE, FIRST HALF
	ADI	80H	;ADD MSB TO SEE IF IT WAS ON
	JC	SUBDONE	;IF CARRY THE SUBSTITUTION IS DONE
	MOV	A,D	;LSB OF DESIRED
	CMP	M	;IS IT THE SAME?
	INX	H	;INCREMENT THE POINTER
	JNZ	NOCMP	;JMP NO COMPARE IF DIFFERENT
	MOV 	A,E	;MSB OF DESIRED
	CMP	M	;IS IT THE SAME
	JZ	SUBT	;IF ZERO GO DO THE SUBSTITUTION
NOCMP	INX	H	;INCREMENT THE POINTER
	INR	C	;INCREMENT THE LOCATION IN THE TABLE
	MOV	A,C	;GET TABLE POSITION
	CPI	MAXMAP+1	;CAUSE CARRY IF MAXMAP OR LESS
	CMC		;INVERT CARRY, 
	MVI	A,'M'	;M IS MAP OVERRUN ERROR
	CC	ERREPORT	;PRINT M IF CARRY
	JMP	FINDN	;GO TEST THE NEXT ENTRY
SUBT:	MVI	B,0	;B,C=THE TABLE ENTRY WHERE THE MATCH OCCURED
	LXI	H,MAXTRK+1	;THE BEGINNING OF THE SUBSTITUTION TRACKS
	DAD	B	;H&L NOW EQUAL THE NEW TRACK
	XCHG		;D&E NOW EQUAL THE NEW TRACK
	JMP	FINDT	;GO SEE IF THE SPARE IS MAPPED
HSTPHY
	LDA	HSTSEC
	OUT	SCTAD
	STA	PSECTOR
	LDA	HSTDSK
	STA	PHEAD
	LHLD	HSTTRK
	MOV	A,H	;MSB OF TRACK
	STA	PTRK	;STORE IT IN PHYSICAL UPPER
	MOV	A,L	;LSB
	STA	PTRK+1	;STORE IN LOWER
;	PHYSICAL ADDRESS NOW SET
	RET
	ENDIF
;
;SUBSTITUTION IS DONE, DO THE SEEK TO THE TRACK IN D&E
SUBDONE
	MOV	A,E	;LSB OF TRACK
	OUT	BUSL
	MOV	A,D	;MSB OF TRACK
	ANI	3	;STRIP ALL BUT TRACK
	OUT 	BUSU	;BUS NOW SET TO TRACK
	MVI	A,20H	;SEEK COMMAND
	OUT	CMND	;DO THE SEEK
	CALL	WT	;WAIT FOR DONE
	MVI	A,'J'
	JC	ERREPORT	;PRINT J IF SEEK TIMEOUT
	RET
;	WAIT FOR DONE, RETURN WITH CARRY OFF WHEN DONE,
;	AND CARRY SET IF TIMEOUT.
WT	MVI	H,0FFH	;H&L WILL BE DECREMENTED FOR A GROSS TIMEOUT
WZ	DCX	H	;DECREMENT COUNT
	MOV	A,H	;PLACE MSB OF COUNT INTO A
	ORA	L	;OR IN LSB TO SEE IF ANY BIT IS NON-ZERO
	JZ	TIMEOUT	;TIMEOUT IF HL ZERO BEFOR DONE
	IN	STATU	;GET STATUS
	ANI	80H	;IS DONE ON?
	JZ	WZ	;IF NOT DONE WAIT
	RET		;GOOD RETURN, CARRY OFF FROM THE ANI 80H
TIMEOUT	STC		;SET CARRY
	RET		;ERROR RETURN
;
;	PANIC ROUTINE FOLLOWS
;	DO FAULT RESET, RECALL, KILL OLDUNIT, CALL KCOMMON
PANIC	CALL RECAL	;RECAL UNIT
	MVI	A,0FFH
	STA	OLDUNIT	;KILL OLD UNIT TO FORCE A SEEK AND SELECT
	CALL 	KCOMMON
	RET
RECAL	XRA	A	;MAKE A ZERO
	OUT	BUSU	;ZERO UPPER BUS
	MVI	A,50H	;FAULT CLEAR AND RECAL BITS
	OUT	BUSL	;SET ONTO BUS
	MVI	A,80H	;FAULT RECOVERY COMMAND
	OUT	CMND	;START FAULT RECOVERY
	XRA	A	;MAKE ANOTHER ZERO
	OUT	CMND	;TURN OFF THE FAULT COMMAND
	CALL	WT	;WAIT FOR DONE
	MVI	A,'K'
	CC	ERREPORT	;PRINT A K IF RECAL TIMEOUT
	RET
;
;	HARD DISK ERROR PRINT
;
ERREPORT:
	STA	DIOST	;SET ERROR FLAG
	LXI	H,ERRORMES
	CALL	PRMSG
	LDA	DIOST	;GET ERROR LETTER
	MOV	C,A	;PLACE ASCII CHARACTER IN C
	CALL	CONOUT	; PRINT THE ERROR LETTER
	CALL	SPACE
;	PRINT THE ADDRESS
NX8	LXI	H,CERRC	;POINT TO THE ADDRESS
	MVI	C,9
NX8N
	CALL	X8
	INX	H
	DCR	C
	JNZ	NX8N
	STC		;SET CARRY
	RET
X8	MOV	A,M
	ANI	0F0H
	RRC
	RRC
	RRC
	RRC
	CALL	HEXOUT
	MOV	A,M
	ANI	0FH
	CALL	HEXOUT
	 CALL	SPACE
	STC
	RET
HEXOUT	ORI	30H
	CPI	3AH
	JC	GOODNUM
	ADI	7
GOODNUM	CALL	CONOUT
	RET
SPACE	MVI	A,' '
	JMP	CONOUT
;	ERRORS INCLUDE;
;	A	WRITE TIMEOUT ERROR
;	B	WRITE FAULT
;	C	READ TIMEOUT
;	D	CHECKWORD
;	E	FORMAT
;	F	HARD READ ERROR
;	G	UNIT SELECT ERROR
;	H	HEAD SELECT ERROR
;	I	HARD SEEK ERROR
;	J	SEEK TIMEOUT
;	K	RECAL TIMEOUT
;	L	MAPPER ERROR
;	M	MAP OVERRUN
PRMSG:	
	MOV	A,M	;PRINT MESSAGE AT H&L TO 0
	ORA	A
	RZ
;	MORE TO PRINT
	PUSH	H
	MOV	C,A
	CALL	CONOUT
	POP	H
	INX	H
	JMP	PRMSG
ERRORMES:
	DB	0DH,0AH
	DB	'HARD DISK ERROR '
	DB	0
;
;	MAPPER ROUTINE
;	GETS THE MAPS OFF EACH DISK AND MAKES A SYSTEM WIDE
;	MAP OF ALL BAD TRACKS
MAXMAP	EQU	65	;20 ENTRIES ALLOWED
MAXUNIT	EQU	1	;NUMBER OF DISK UNITS
	IF	MAPEN	;ASSEMBLE ONLY IF MAP IS ENABLED
SMAPPER
;	SET PHYSICAL ADDRESS TO FIRST
	XRA	A	;MAKE A ZERO
	STA	HSTTRK
	STA	HSTTRK+1
	LXI	H,SUBTBL
	SHLD	SUBPNT
	MVI	A,HSTSPT-1	;LAST SECTOR NUMBER
	STA	HSTSEC	;SET IT FOR KCOMMON
;	CLEAR THE MAP
	MVI	A,0E5H
	MVI	B,2*MAXMAP+1
CLRMAP	MOV	M,A
	INX	H
	DCR	B
	JNZ	CLRMAP
GETMAP		;SEE IF SURFACE IS PRESENT
	CALL	HSTPHY
	MVI	A,UNIT
	RLC
	RLC
	RLC
	RLC
	OUT	BUSU
	MVI	A,10H	;SELECT UNIT COMMAND
	OUT	CMND
	IN	STATU	;CHECK UNIT STATUS
	ANI	1
	JZ	NEXTMAP	;IF NOT SELECTED GO TO NEXTMAP
	LDA	PHEAD
	IF	CMD
	CPI	0
	JZ	CARTH	;IF CARTRIDGE THE HEAD ADDRESS IS GOOD
	ADI	15	;OTHERWISE SET VOLUMN BIT
	ENDIF
CARTH	OUT	BUSL
	MVI	A,40H
	OUT	CMND	;SELECT HEAD
	IN	STATU
	ANI	20H
	JNZ	NEXTMAP
	CALL	READINT	;READ WITHOUT DMA
	JC	START
RDMAPBUF:
	LHLD	SUBPNT	;SET H&LTO MAP ADDRESS
NBADTRK	IN	SCTBU	;GET FIRST BYTW
	CPI	0E5H	;IS IT THE END
	JZ	NEXTMAP	;IF END DO THE NEXT SURFACE
	MOV	B,A	;PUT BYTE IN B (TRACK MSB)
	LDA	PUNIT	;GET THE UNIT NUMBER
	RRC		;POISITION UNIT BITS
	RRC
	RRC
	ANI	60H	;GET RID OF ANY OTHER JUNK
	ORA	B
	MOV	B,A	;PUT TRACK AND UNIT IN B
	LDA	PHEAD	;GET HEAD
	RLC		;POISITION BITS
	RLC
	ANI	1CH
	ORA	B	;OR WITH TRACK AND UNIT
	MOV	M,A	;PLACE INTO TABLE
	INX	H	;POINT TO NEXT BYTE IN TABLE
	IN	SCTBU	;GET SECOND BYTE OF TABLE
	MOV	M,A	;ENTRY IS COMPLETE
	INX	H	;POINT TO NEXT
	MVI	M,0E5H	;SET END OF TABLE
	SHLD	SUBPNT
	JMP	NBADTRK	;GO GET ADDRESS OF NEXT BAD TRACK
NEXTMAP
	LDA	HSTDSK
	INR	A
	STA	HSTDSK
	CPI	HEADQ	;ARE WE DONE WITH THIS UNIT?
	JZ	NEWUNIT	;IF SO, DO NEXT UNIT
	JMP	GETMAP
NEWUNIT
;	XRA	A	;MAKE A ZERO
;	STA	PHEAD	;NEW UNIT, START WITH FIRST SURFACE
;	LDA	PUNIT	;GET UNIT	
;	INR	A	;INCREMENT IT
;	STA	PUNIT	;SET IF
;	CPI	NUMHRD/HEADQ
;	JNZ	GETMAP
	RET		;ALL DONE
	ENDIF
RTAPE
	LXI	D,BIGBUF
	LXI	H,9216
	CALL	CTCRD
	OUT	0FFH
	OUT	0FFH
	CPI	'E'
	JNZ	BETA
	LDA	S$TRK
	INR	A
	STA	S$TRK
	CALL	REWIND
	JMP	RTAPE
BETA	CPI	00
	JZ	WRITREC
	CALL	TAPERR
	JMP	WRITREC
WTAPE
	LXI	D,BIGBUF
	LXI	H,9216
	CALL	CTCWRT
	CPI	'E'
	JNZ	ALPHA
	LDA	D$TRK
	INR	A
	STA	D$TRK
	CALL	REWIND
	JMP	TAPERTN
ALPHA	CPI	00
	JZ	TAPERTN
	CALL	TAPERR
	JMP	TAPERTN
TAPERTN
	LHLD	S$TRK
	LXI	D,-MAXTRK
	DAD	D
	JNC	READREC
	RET
TAPERR	STA	TPERR
	LXI	D,TAPEMES
	CALL	PMES
	LDA	TPERR
	CALL	CONOUT
	RET
;  THE FUNCION OF THIS SUBROUTINE IS TO WRITE THE
;  CTC TAPE DRIVE.  
;  UPON ENTERING THE ROUTINE WAITS FOR THE TAPE TO STOP
;  BEFOR WRITING AND EXITS AFTER TURNING OFF THE FOWARD
;  MOTION COMMAND BUT BEFOR WAITING FOR THE TAPE TO 
;  TO STOP.  THIS ALLOWS THE NEXT RECORD TO BE PREPAIRED 
;  DURING THE RAMP DOWN PERIOD.
;
;  PARAMETERS UPON ENTRY:
;          A       DON'T CARE
;          B,C     DON'T CARE
;          D,E     LOCATION OF FIRST BYTE IN MEMORY
;          H,L     CHARACTER COUNT
;
;  REGISTERS UPON EXITING
;          A       STATUS
;          'D'     DATA LATE
;          'C'     CRC ERROR
;          'S'     SELECT ERROR
;          'P'     WRITE WHILE PROTECTED
;          'E'     EARLY WARNING
;  
;
;          B,C     UNDEFINED
;          D,E     CHARACTERS LEFT
;          H,L     UNDEFINED
;
;
DATBASE     EQU     98H     ;BASE OF IO PORTS
DAT                EQU     DATBASE+3        ;PORT ADDRESS FOR DATA
SEL                EQU     DATBASE+2        ;ADDRESS TO SELECT TRACK AND UNIT
CARTSTAT   EQU     DATBASE+2
RWSTAT     EQU             DATBASE+1
MOT                EQU     DATBASE+1        ;TAPE MOTION COMMAND
RWC                EQU     DATBASE+0        ;READ WRITE CONTROL
;
;
;
;  MAKE SURE THAT THE DRIVE IS SELECTED AND STOPED
CTCWRT     SHLD    XCOUNT
   XCHG
   SHLD    WBUFAD  ;STORE BUFFER ADDRESS AND COUNT TO ALLOW RETRIES
           IN      CARTSTAT
           ANI     40H             ;IS IT SELECTED?
           MVI     A,'S'   ;SELECT ERROR CODE
           RNZ     ;IF ERROR, RETURN TO REPRORT
MOVING     IN      CARTSTAT
           ANI     8H              ;GET BUSY BIT
           JZ      MOVING          ;IF STILL MOVING WAIT
           IN      CARTSTAT
           ANI     2               ;IS IT PROTECTED?       
           MVI     A,'P'   ;PROTECT ERROR CODE
           RNZ     ;IF ERROR GO REPORT IT
;  IF AT LOAD POINT ERASE LEADER 
   IN      CARTSTAT
   ANI     4       ;GET LOAD POINT
   CZ      LEADER  ;IF TRUE (0), WE MUST ERASE LEADER
;          STATUS IS OK, WE CAN NOW START THE WRITE!!
REWRT              MVI A,10H       ;TURN ON ERASE BEFOR MOVING TAPE
           OUT     RWC
           MVI     A,12H   ;FOWARD BIT AND CRC RESET
           OUT     MOT             ;AWAY WE GO!!
;THE FOWARD COMMAND STARTS THE 33 MILLISECOND TIMER
   LHLD    WBUFAD
   XCHG
   LHLD    XCOUNT
           MOV     A,H     ;COMPLEMENT THE COUNT IN H&L
           CMA
           MOV     H,A
           MOV     A,L
           CMA
           MOV     L,A
WT33               IN      RWSTAT  ;SEE IF 33 MILLISECONDS ARE UP
           ANI 10H
           JNZ     WT33
;	IF AT EARLY WARNING ERASE TO END, DO NOT DO WRITE
	IN	CARTSTAT
	RRC
	JNC	ERA2ND
;  WRITE THE PREAMBLE
           MVI     B,5     ;PREAMBLE COUNT
           MVI     A,1AH   ;ERASE,WRITE DATA EN, WRITE
           OUT     RWC     ;START TO WRITE DATA
PREWT              XRA     A       ;MAKE A ZERO
           OUT     DAT     ;THERE GOES ANOTHER PREAMBLE
           DCR     B       ;ARE THEY DONE?
           JNZ     PREWT   ;WAIT FOR THE PREAMBLE BYTE TO FINISH
;                  ;THEN SEND ANOTHER
           LXI     B,01    ;SET B/C=1
           DAD     B
   MVI     A,01    ;GET SYNC BIT
           OUT     DAT     ;XMIT THE SYNC BIT
;  SYNC NOW DONE ( IT'S NOW IN THE SHIFT REGISTER)
           XRA     A
           OUT     DAT     ;SEND A ZERO BYTE AFTER SYNC
;  THE ZERO BYTE IS ON IT'S WAY OUT, ALLOW CRC COMPILE!
           MVI     A,2     ;FOWARD MOTION BUT NOT CRC RESET
           OUT     MOT
SENDAT     LDAX    D        ;GET BYTE OF DATA
           OUT     DAT     ;SEND IT
           DAD     B       ;ADD TO 2S COMP. OF THE COUNT
           JC      DDONE   ;IF CARRY, THE BYTES ARE DONE
	INX	D
           JMP     SENDAT  ;IF DONE SEND THE NEXT WORD
DDONE              MVI     A,3AH
           OUT     RWC     ;SET CRC TRANS.
	XRA	A
	OUT	DAT	;CRC NOW GOING OUT
	IN	RWSTAT
	MOV	E,A	;STORE STATUS IN E
	OUT	DAT	;SECOND CRC BYTE
	MVI	A,1AH	;TURN OFF CRC
	OUT	RWC
	MVI	B,48
	XRA	A
PLP	OUT	DAT
	DCR	B
	JNZ	PLP
; WE ARE NOW DONE WITH THE WRITE
   MVI     A,14H   ;ERASE BIT AND READ
   OUT     RWC     ;TURN OFF WRITE, LEAVE ERASE ON, TURN ON READ
;  WAIT FOR 230 BYTES TO PASS READ HEAD TO CENTER OF CRC WINDOW
;  THIS IS DONE DO TO A GLITCH ON THE READ DATA THE DEI CAUSES
;  AT THE DROP OF WRITE ENABLE WHICH WOULD OTHERWISE PREVENT
;  TESTING CRC WITH A READ AFTER WRITE.
   MVI     D,0E1H
CRCCEN             DCR     D       ;DECREMENT WORD COUNT
           OUT      DAT     ;TURN OFF DONE
           JNZ     CRCCEN  ;IN NOT DONE WAIT LONGER
DADERR     IN      RWSTAT  ;IF DONE IT GETS THE STATUS
           MOV     C,A     ;SAVE STATUS TO ALLOW CRC TEST LATER
	CALL	WDADF	;WAIT FOR DATA DETECT TO GO AWAY
;   READ CRC IS NOW COMPUTED AND MAY BE
	XRA	A
;  TESTED.  FIRST WE WILL STOP THE TAPE...
	OUT	MOT
           MOV     A,C     ;RECAL THE CRC
           ANI     4
           MVI     A,'C'   ;CRC ERROR CODE
           JNZ     CRCER   
	MOV	A,E	;GET READ/WRITE STATUS
	ANI	2	;LOOK AT DATA LATE
	MVI	A,'D'	;DATA LATE ERROR CODE
	RNZ		;REPORT IT IF NEEDED
	XRA	A
	RET
ERA2ND	IN	CARTSTAT	;ERASE TO END OF TAPE
	ANI	8
	JZ	ERA2ND		;KEEP GOING WHILE MOVING
	XRA	A
	OUT	MOT	;TURN OFF FOWARD
	MVI	A,'E'
	RET		;RETURN EARLY WARNING STATUS
;  LEADER ERASES THRU BOT PLUS FOUR INCHES
LEADER     MVI     A,10H   ;TURN ON ERASE
   OUT     RWC
   MVI     A,2
   OUT     MOT     ;FOWARD HO!
LPWRT      IN      CARTSTAT
   ANI     4       ;GET LOAD POINT STATUS
   JZ      LPWRT   ;IF TRUE (0), WAIT
   CALL    ERA4    ;ERASE 4 INCHES
   RET
; ERASE FOUR INCHES
ERA4       MVI     B,4     ;INCHES TO ERASE
   MVI     A,10H
   OUT     RWC     ;TURN ON ERASE
NINCH      XRA     A
           OUT     MOT
           MVI     A,2
   OUT     MOT     ;FOWARD MOTION COMMAND
INCH       IN      RWSTAT
           ANI     10H     ;GET 33 MILLISEC BIT
           JNZ     INCH
           DCR     B
           JNZ     NINCH   ;DO ANOTHER INCH
           RET
CRCER      CALL    BACKSPACE
   CALL    ERA4
   JMP             REWRT
BACKSPACE	IN	CARTSTAT	;WAIT TILL TAPE STOPS
		ANI	8
		JZ	BACKSPACE
		MVI	A,4		;START TAPE BACKWARDS
		OUT	MOT
		CALL	WDADT		;WAIT FOR DATA DETECT TRUE
;T;	CALL	WDADF	;WAIT FOR DATA DETECT FALSE
;T;	LXI	B,1666	;GENERATE A 10MS DELAY (20MS AT 2MZ)
;T;DELA	DCX	B
;T;	MOV	A,B
;T;	ORA	C
;T;	JNZ	DELA
WAITH	LXI	B,820	;COUNT TO CAUSE 10 MIL DELAY AT 4MZ, 20 AT 2MZ
DELA	DCX	B
	IN	CARTSTAT
	RLC
	JNC	WAITH
	MOV	A,B
	ORA	C
	JNZ	DELA
;STOP AND WAIT
   XRA     A
   OUT     MOT
AC IN              CARTSTAT
   ANI     8
   JZ      AC      ;IF MOVING (BUSY TRUE,0) WAIT
   RET
WBUFAD     DS      2	;THIS & XCOUNT MUST BE PASSED BY INVOKING PGM
XCOUNT     DS      2
;  THE FUNCTION OF THIS ROUTINE IS TO READ THE CTC TAPE
;
;  PARAMETERS UPON ENTERY:
;          A       DONT CARE
;          BC      DONT CARE
;          DE      LOCATION OF FIRST MEMORY BYTE TO RECIEVE DATA
;          H,L     CHARACTER COUNT
;REGISTERS UPON EXITING
;  A = STATUS
;          'D'     DATA LATE
;          'C'     CRC ERROR
;          'S'     SELECT ERROR
;          'E'     END OF TAPE
;
;
;          B,C     UNDEFINED
;          D,E     UNDEFINED
;
;          H,L     UNDEFINED
;
;  MAKE SURE THE DRIVE IS SELECTED
CTCRD	XRA	A	;ZERO RETRY COUNTER
           STA     RETRYS
	SHLD	XCOUNT	;SAVE COUNT & BUFFER ADDR.FOR RETRIES
	XCHG
	SHLD	WBUFAD
REENTERR	LHLD	WBUFAD	;THIS IS THE RE-ENTRY PT. FOR REREADS
	XCHG
	LHLD	XCOUNT
	CALL	READS
           CPI     'C'
   JZ      BADCRC
;   CPI     0	;THESE 8 LINES ARE REMARKED OUT TO
;   RNZ
;   LDA     RETRYS
;   CPI     0
;   JZ      ERRFRE
;   ADI     30H     ;MAKE THE NUMBER OF RETRYS AN ASCII CHAR
;   RET
;ERRFRE     XRA     A
   RET
BADCRC     LDA     RETRYS
   INR     A
   CPI     5       ;NUMBER OF RETRIES ALLOWED
   STA     RETRYS
   MVI     A,'C'
   RZ              ;IF RETRYS IS ZERO, REPORT IT AS A HARD ERROR
   CALL    BACKSPACE
   JMP     REENTERR
READS      IN      CARTSTAT
           ANI     40H     ;IS IT SELECTED?
           MVI     A,'S'   ;SELECT ERROR CODE
           RNZ             ;IF ERROR, RETURN TO REPORT
;  COMPLEMENT THE COUNT IN H,L
           MOV     A,H
           CMA
           MOV     H,A
           MOV     A,L
           CMA
           MOV     L,A
	CALL	WDADF	;WAIT FOR DATA DETECT TO GO AWAY
;  MAKE TAPE GO FOWARD 
           MVI     A,12H   ;FOWARD MOTION BIT AND CRC RESET
           OUT     MOT     ;AWAY WE GO
RDBOT	IN	CARTSTAT
	ANI	4
	JZ	RDBOT
           MVI     A,2     ;FOWARD MOTION, NO CRC RESET
           OUT     MOT
           MVI     A,4     ;READ COMMAND
           OUT     RWC
           LXI     B,01    ;SET B/C=1 TO DAD (HL=COMPL.OF COUNT)
	DAD	B	;TO BE CONSISTENT WITH READ
;  WE NOW WAIT FOR DATA DETECT OR BUSY-NOT
;  BUSY-NOT INDICATES THE END OF TAPE HAS BEEN REACHED
NOTEND     IN      CARTSTAT        ;GET CARTRIDGE STATUS
	RLC
	JNC	DATARDY
	ANI	10H
	JZ	NOTEND
;	OOPS. END OF TAPE
   XRA     A
   OUT     RWC     ;TURN OFF THE READ
           OUT     MOT     ;STOP THE  TAPE
           MVI     A,'E'   ;END STATUS
           RET             ;GO REPORT
DATARDY            IN      DAT     ;THROW AWAY FIRST BYTE AFTER SYNC!
   IN      DAT
RDDATW     IN      DAT     ;GET DATA
   STAX    D       ;PUT IT INTO MEMORY
           DAD     B       ;ADD 1 TO COMPLEMENT OF COUNT
           JC      CRCXXX  ;IF CARRY THE READ DATA IS DONE
           INX     D       ;INCREMENT THE MEMORY LOCATION
           JMP     RDDATW  ;GET NEXT BYTE
;  THE READ IS NOW DONE 
;  WE MUST WAIT FOR THE SECOND CRC BYTE AND THEN SHUT DOWN
;  (THE FIRST CRC BYTE IS ALREADY ON ITS WAY IN)
CRCXXX MVI B,3     ;BYTES TO WAIT BEFOR CHECKING CRC
CRCRWT  IN DAT     ;TURN ON WAIT
           DCR     B
           JNZ     CRCRWT
   IN      RWSTAT  ;GET STATUS TO SAVE DATA LATE & CRC
   MOV     B,A
	CALL	WDADF	;WAIT FOR DATA DETECT TO GO AWAY
			;TO INSURE STOPPED SAME AS WRITE
           XRA     A       ;GENERATE A ZERO
           OUT     RWC     ;TURN OFF THE READ
           OUT     MOT     ;STOP IT
           MOV     A,B     ;RECALL STATUS AGAIN
           ANI     4       ;IS CRC ON?
           MVI     A,'C'   ;CRC ERRPR CODE
           RNZ             ;GO REPORT THE ERROR
	MOV	A,B	;RECALL ENDIND STATUS
	ANI	2	;IS DATA LATE ON?
	MVI	A,'D'	;DATA LATE ERROR CODE
	RNZ		;IF ERROR THEN REPORT IT
           XRA     A
           RET
WDADT	IN	CARTSTAT
	RLC
	JC	WDADT
	IN	CARTSTAT
	RLC
	JC	WDADT
	RET
WDADF	IN	CARTSTAT
	RLC
	JNC	WDADF
	IN	CARTSTAT
	RLC
	JNC	WDADF
	RET
RETRYS     DS      1
;
REWIND      IN      CARTSTAT
    ANI     08H     ;CHECK BUSY BIT
    JZ      REWIND  ;LOOP UNTILL BUSY GOES AWAY
    XRA     A       ;MAKE A ZERO
    OUT     RWC     ;TURN OFF ANY READ OR WRITE
    MVI     A,8     ;TURN ON REWIND
    OUT     MOT     ;AWAY WE GO     !
    XRA     A       ;ANOTHER ZERO
    OUT     MOT     ;DROP REWIND COMMAND
;RWWT        IN      RWSTAT
;            ANI     8H
;            JNZ     RWWT    ;IF FLAG IS FALSE (1), WAIT
    RET
STATUS      DS      1       ;STATUS LOCATION
;
;
;	DO NOT CHANGE THE ORDER OF THE NEXT 9 BYTES
CERRC	DB	0	;ERROR COUNTER
PUNIT	DS	1	;DESIRED PHYSICAL UNIT
PTRK	DS	2	;DESIRED REAL TRACK ADDRESS
PHEAD	DS	1	;DESIRED HEAD
PSECTOR	DS	1	;DESIRED SECTOR,512 BYTE
OLDUNIT	DB	0FFH	;LAST HEAD SELECTED, FF TO CAUSE INITIAL SEL.
OLDTRK	DW	0FFFFH	;LAST TRACK SEEKED
OLDHEAD	DB	0FFH	;LAST HEAD ACCESSED
;
;
;
;	THE REMAINDER OF THE CBIOS IS RESERVED UNINITIALIZED
;	DATA AREA, AND DOES NOT NEED TO BE A PART OF THE
;	SYSTEM MEMORY IMAGE (THE SPACE MUST BE AVAILABLE,
;	HOWEVER, BETWEEN "BEGDAT" AND "ENDDAT").
;
TRACK:	DS	2	;TWO BYTES FOR EXPANSION
SECTOR:	DS	2	;TWO BYTES FOR EXPANSION
DMAAD:	DS	2	;DIRECT MEMORY ADDRESS
DISKNO:	DS	1	;DISK NUMBER 0-15
RORW:	DS	1	;READ OR WRITE SELECTED
DIOST:	DS	1	;I/O RETURN STATUS 0 OK
HDLD:	DS	1	;HEADLOAD FLAG BIT
	DS	50
STACK	DS	2
;
SUBTBL:	DS	2*MAXMAP+1
SUBPNT	DS	2
BIGBUF	DS	512*SPXFER