;		--- PASCAL BOOTER PROGRAM ---
;			DEC 1979
;
;						S. J. SINGER
;						GEORGE BOLTHOFF
;
;
;NOTES ADDED 21-FEB-80, Jim Gagne:
;  
;BAD NEWS:	To avoid copyright hassles, I have removed from this file all
;   code identical with the UCSD original, whether in PINIT.ASM on the CP/M
;   disk or in CPMIO.TEXT on the interpreter source disk.  You'll have to
;   replace it yourself, remembering to change the Zilog-style memnomics of
;   the inserted interpreter code to the Intel-style memnomics supported by
;   the Digital Research macroassembler.
;The deleted code has been replaced by asterisked messages in such a way
;   that the file will NOT assemble.
;YOU MUST HAVE Digital Research's macroassembler and Z80 macrolibrary to as-
;   semble this file correctly.  Note that relative jumps and other Z-80-
;   specific code is used extensively, primarily in the PBIOS section.  Both
;   of these factors are easily changed for other systems if you have a good
;   editor.
;
;	THIS PROGRAM IS A COMBINATION OF PINIT THE PASCAL INITIALIZATION
;PROGRAM AND A BIOS THAT SUPPORTS BOTH STANDARD IBM 3740 FORMAT DISKS AS WELL
;AS DISKS FORMATTED INTO 512 BYTE BLOCKS SINGLE AND DOUBLE DENSITY. THE PROGRAM
;HAS CONDITIONAL ASSEMBLIES FOR 4 DIFFERENT DISK CONTROLLERS, THE OLD TARBELL
;1771 CONTROLLER, THE NEW TARBELL DOUBLE DENSITY CONTROLLER , THE DELTA
;DOUBLE DENSITY CONTROLLER AND THE CROMEMCO 4FDC CONTROLLER (SINGLE DENSITY).
;	THE INITIALIZATION SECTION POLLS UP TO 4 DRIVES AND INITIALIZES THE
;SYSTEM FOR THE DRIVES WHICH ARE READY. DRIVES 0 AND 1 CORRESPOND TO PASCAL
;LOGICAL UNITS 4 AND 5 RESPECTIVELY WHILE DRIVES 2 AND 3 CORRESPOND TO PASCAL
;LOGICAL UNITS 9 AND 10. AT LEAST ONE DRIVE UNIT 4 MUST BE READY.
;	THE PROGRAM THEN READS TRACK ZERO SECTOR ONE FOR EACH UNIT THAT IS
;READY AND EXAMINES THE FORMAT BYTE 7FH TO DETERMINE THE PROPER INITIALIZATION
;FOR EACH DISK. AT PRESENT FIVE DIFFERENT FORMATS ARE SUPPORTED.
;
;	FMT CODE			DISK FORMAT			BLOCKS
;	  20H	  SNGL DENSITY, SNGL SIDED, 26 SECTORS/TRK 128 BYTES      494
;	  22H	  SNGL DENSITY, SNGL SIDED,  8 SECTORS/TRK 512 BYTES      608
;	 0A2H	  SNGL DENSITY, DBL  SIDED,  8 SECTORS/TRK 512 BYTES	 1216
;	  12H	  DBL  DENSITY, SNGL SIDED, 16 SECTORS/TRK 512 BYTES     1216
;	  92H	  DBL  DENSITY, DBL  SIDED, 16 SECTORS/TRK 512 BYTES     2448
;
;
;IF AN IMPROPER FORMAT CODE IS READ SUCH AS ANY DOUBLE DENSITY CODE WITH
;A SINGLE DENSITY TARBELL CONTROLLER THE PROGRAM WILL HALT WITH AN ERROR MESSAGE
;A FORMAT CODE OF 0DDH IS ASSUMED TO BE DOUBLE DENSITY 128 BYTE SECTORS AND
;ANY OTHER CODE IS ASSUMED TO IDENTIFY A STANDARD IBM 3740 DISKETTE.
;IF THE DISK FORMATTING PROGRAM 'DFOCO' IS USED TO FORMAT THE DISKS THE
;PROPER FORMAT BYTE IS AUTOMATICALLY PLACED ON TRACK ZERO SECTOR ONE.
;SYSTEM VARIABLES ARE INITIALIZED FOR ALL DRIVES THAT ARE READY. IF FORMATS
;ARE DETERMINED TO BE INCOMPATABLE THE SYSTEM WILL HALT WITH AN ERROR MESSAGE
;IDENTIFYING THE DRIVE HAVING THE INCORRECT FORMAT (FOR EXAMPLE A DOUBLE
;DENSITY DISK WITH A 1771 CONTROLLER) AND ASK YOU TO REBOOT.
;
;  OFFSET FOR 64K SYSTEM IS 1380H IF BIOS STARTS AT 0FA00H
; 
FALSE	EQU	00H	;LOGICAL FALSE
TRUE	EQU	NOT FALSE
;
STEP	EQU	1	;STEP RATE 1791  0=3 MSEC, 1=6 MSEC, 2=10 MSEC
MSIZE	EQU	64	;MEMORY SIZE IN DECIMAL KB
BIOSSZ	EQU	1536	;BYTES IN THIS BIOS
LOADP	EQU	MSIZE*1024-BIOSSZ	;LOAD POINT
REMOTE	EQU	FALSE	;REMOTE I/O (SERIAL RS232C)
THREES	EQU	FALSE	;ASSEMBLE CODE FOR BASIC-4 SPECIAL 3'S FORMAT
;
;		-- DISK CONTROLLERS --
;
C4FDC	EQU	FALSE	;CONDITIONAL FOR CROMEMCO 4FDC DISK CONTROLLER
DELTA	EQU	TRUE	;CONDITIONAL ASSMEBLY FOR DELTA CONTROLLER
TARBELL	EQU	FALSE	;CONDITIONAL ASSEMBLY FOR NEW TARBELL CONTROLLER
OLDTARB	EQU	FALSE	;CONDITIONAL FOR OLD TARBELL CONTROLLER (1771)
;
;		-- TERMINAL I/0 CONTROLLERS
;
ISIO2	EQU	TRUE	;CONDITIONAL FOR IMSAI SIO-2 SERIAL BOARD (8251'S)
PT3PLUS	EQU	FALSE	;CONDITIONAL FOR PROCESSOR TECH 3P+S BOARD
TUART	EQU	FALSE	;CONDITIONAL FOR CROMEMCO TUART SERIAL BOARD
DELTAIO	EQU	FALSE	;CONDITIONAL FOR 8251'S ON DELTA CPU BOARD
;
;		-- TERMINALS --
;
ADM3A	EQU	TRUE	;CONDITIONAL FOR ADM-3A TERMINAL
SOROC	EQU	FALSE	;CONDITIONAL FOR SOROC OR OTHER TERM NO SOFTWARE DRV
BASIC4	EQU	FALSE	;CONDITIONAL FOR BASIC 4 TERMINAL
;
;		-- PRINTER CONTROLLERS --
;
CROMEM	EQU	FALSE	;CONDITIONAL FOR CROMEMCO PARALLEL (CENTRONIX TYPE)
;
;
;		-- REMOTE SERIAL (RS232C) CONTROLLERS --
;
RTUART	EQU	FALSE	;CROMEMCO TUART USED FOR REMOTE IN AND REMOTE OUT
;
;
;
;		-- FLOPPY DISK DRIVES --
;
PERSCI	EQU	FALSE	;CONDITIONAL FOR FAST SEEK ON DUAL PERSCI DRIVES
;
;
;
;  ---- LIST (PRINTER) EQUATES ----
;
	IF	CROMEM	;CENTRONIX TYPE PARALLEL
LSTAT	EQU	54H	;LIST STATUS PORT
LDATA	EQU	54H	;LIST DATA PORT.
LMASK	EQU	20H	;LIST DATA READY MASK
	ENDIF
;
;
; -----  REMOTE EQUATES -----
;
	IF	RTUART
RABASE	EQU	50H	;BASE PORT CHANNEL A
RBBASE	EQU	60H	;BASE PORT CHANNEL B
RASTAT	EQU	RABASE	;CHANNEL A STATUS PORT
RBSTAT	EQU	RBBASE	;CHANNEL B STATUS PORT
RADATA	EQU	RABASE+1;CHANNEL A DATA PORT
RBDATA	EQU	RBBASE+1;CHANNEL B DATA PORT
RACMND	EQU	RABASE+2;CHANNEL A COMMAND PORT
RBCMND	EQU	RBBASE+2;CHANNEL B COMMAND PORT
RIMASK	EQU	40H	;INPUT MASK RDA - RECEIVER DATA AVAILABLE
ROMASK	EQU	80H	;OUTPUT MASK TBE - TRANSMITTER BUFFER EMPTY
	ENDIF
;
; -----  TERMINAL EQUATES -----
;
	IF	ISIO2
TSTAT	EQU	3H	;STATUS AND COMMAND PORT
PORT01	EQU	2H	;SERIAL PORT 1
IMSK01	EQU	02H	;RX READY PORT 1
OMSK01	EQU	01H	;TX READY PORT 1
CMMND	EQU	0CEH	;USART INITIALIZATION COMMAND
; 8251 USART INIT. EQUATES,8 BIT CHAR-NO PARITY
; 2 STOP BITS-BAUD RATE 16X...COMMAND WORD = 0CEH
	ENDIF
;
	IF	PT3PLUS
TSTAT	EQU	00H	;TERMINAL STATUS AND COMMAND PORT
PORT01	EQU	01H	;TERMINAL DATA PORT
IMSK01	EQU	01H	;RX READY PORT 1
OMSK01	EQU	80H	;TX READY PORT 1
	ENDIF
;
	IF	C4FDC	;FOR USING SERIAL PORT ON CROMEMCO DISK CONTROLLER
TSTAT	EQU	00H	;STATUS PORT
PORT01	EQU	01H	;DATA PORT
IMSK01	EQU	40H	;RX READY PORT 1
OMSK01	EQU	80H	;TX READY PORT 1
	ENDIF
;
;
CTRLS	EQU	19	;CONTROL S USED TO STOP DISPLAY ON TERMINAL
CR	EQU	13	;ASCII CARRIAGE RETURN
TAB	EQU	 9	;ASCII TAB CHAR
ESC	EQU	27	;ASCII ESCAPE CHAR
;
;   ----- DISK DRIVER EQUATES -----
;  
	IF	C4FDC
DISK	EQU	30H	;DISK PORT BASE ADDR FOR CROMEMCO 4FDC
	ELSE
DISK	EQU  0F8H	;DISK BASE ADDRESS.
	ENDIF
DCOM	EQU  DISK	;DISK COMMAND PORT.
DSTAT	EQU  DISK	;DISK STATUS PORT.
TRACK	EQU  DISK+1	;DISK TRACK PORT.
SECTP	EQU  DISK+2	;DISK SECTOR PORT.
DDATA	EQU  DISK+3	;DISK DATA PORT.
WAIT	EQU  DISK+4	;DISK WAIT PORT.
DCONT	EQU  DISK+4	;DISK CONTROL PORT.
RTCNT	EQU  10		;RETRY COUNT.
;
;---- PASCAL IO TEMPORARIES ---
;---- PBIOS TEMPORARIES ---
;*******************************
;*  Don't forget to change BIOSADR if you have moved TIO in the interpreter
;*  This table is the main vehicle of communications between the interp and
;*  PBIOS.
;*******************************
;
BIOSADR:EQU	40H		;CONTAINS HEX ADDR OF START OF BIOS
UPTR	EQU	BIOSADR+2
UREQ	EQU	UPTR+2
UNIT	EQU	UREQ+1
UBUF	EQU	UNIT+1
ULEN	EQU	UBUF+2
UBLK	EQU	ULEN+2
UASY	EQU	UBLK+2
URTN	EQU	UASY+2
ERRFLG	EQU	URTN+2
;
BIOSTEM:EQU	70H		;ADDITIONAL TEMPORARIES FOR BIOS VARIABLES
SECLEN	EQU	BIOSTEM		;SECTOR LENGTH CODE 0=128 BYTES 2=512 BYTES
DSKDR	EQU	SECLEN+1	;CURRENTLY SELECTED DISK DRIVE
NUMSEC	EQU	DSKDR+1		;NUMBER OF SECTORS PER TRACK (8 OR 16 FOR 512)
NUMDSK	EQU	NUMSEC+1	;NUMBER OF DISKS ON LINE  1 TO 4
DBLSID	EQU	NUMDSK+1	;FLAG TRUE IF DOUBLE SIDED DISK
ERCNT	EQU	DBLSID+1	;ERROR COUNT FOR DISK I/O OPERATIONS
TRK	EQU	ERCNT+1		;USED IN DISK MAPPING
DTRK	EQU	TRK+1		;USED IN DISK MAPPING
SECT	EQU	DTRK+1		;USED IN DISK MAPPING
DSCT0	EQU	SECT+1		;USED IN DISK MAPPING
DSCT	EQU	DSCT0+1		;USED IN DISK MAPPING
IDTAB	EQU	DSCT+1		;BUFFER FOR ID READ USED IN ERROR RIDOVERY
TRKTBL	˙QU	IDTAB+6		;CONTAINS PARAMETERS FOR ALL DISK DRIVES
;
;	FOR FLOPPY DISKS TRKTBL CONTAINS TRACK SECTOR SIZE AND DENSITY FOR EACH
;	DISK DRIVE (MAX OF FOUR FLOPPY DISK DRIVES AT PRESENT)
;
;DRIVE	ADDR		TRACK		DENSITY		SECSIZ
;  4	TRKTBL		0 - 76		1 OR 2		0 OR 2
;  5	TRKTBL+3
;  9	TRKTBL+6
; 10	TRKTBL+9
;
;
ASNCBIT	EQU	01H
DRCTBIT	EQU	02H
ASYBIT	EQU	01H
DSKBIT	EQU	02H
EOFBIT	EQU	04H
DLEBIT	EQU	04H
CRLFBIT	EQU	08H
INBIT	EQU	01H
OUTBIT	EQU	02H
CLRBIT	EQU	04H
ALLBIT	EQU	07H
;  
;
	MACLIB Z80	;INCLUDE Z-80 MICROS
;
BIOS		EQU	MSIZE*1024-BIOSSZ
IBASE		EQU	BIOS-1024	;1024 byte allowed
INTERP$BASE	EQU	100H		;first loc used by inte
PBEGIN		EQU	INTERP$BASE+100H
FIRSTSP		EQU	INTERP$BASE+103H
DENTSZ		EQU	1AH		;dir entry size,bytes
DTITLE		EQU	06H
NBLOCKS		EQU	19		;MAX SIZE OF SYSTEM.MICRO
DIRTOP		EQU	IBASE-1000H
BUFFER		EQU	DIRTOP		;USED FOR DENSITY DETERMINATION
;
	ORG	IBASE
;
	LXI	SP,100H			;INITIALIZE STACK POINTER
	JMP	INIT$IO
MAIN:	LXI	H,DIRTOP
	CALL	READ$DIR	;read dir into dirtop
	LXI	H,DIRTOP	;set dir entry pointer
	LXI	D,DENTSZ	;to firet entry after volume
	DAD	D
	SHLD	DENTP
;
	CALL	FIND$INTERP	;find the interpreter
	LXI	H,LDMSG
	CALL	MSG
	CALL	READ$INTERP	;then read it in
;
	JMP	PBEGIN		;boot in SYSTEM.PASCAL
;
; ---- INITIALIZE I/O -----
;All terminal,UART,etc initializing to be done here
;Initialize terminal first,in case error message needed
	IF	PT3PLUS OR C4FDC
INIT$IO:NOP
	ENDIF
;
;
	IF	ISIO2		;INITIALIZE 8251
INIT$IO:MVI	A,80H
	OUT	TSTAT		;DO A SOFTWARE RESET
	MVI	A,80H		;KILL SOME TIME !
	OUT	TSTAT
	MVI	A,40H		;HERE'S THE RESET
	OUT	TSTAT
	MVI	A,CMMND		;INIT 8251
	OUT	TSTAT
	MVI	A,37H
	OUT	TSTAT
	ENDIF
;
	IF	RTUART		;INITIALIZE CROMEMCO TUART
	MVI	A,1
	OUT	RACMND
	OUT	RBCMND		;RESET CHANNELS A AND B - NO INTERRUPTS
	MVI	A,0C0H
	OUT	RASTAT		;9600 BAUD, 1 STOP BIT CHANNEL A
	OUT	RBSTAT		;SAME FOR CHANNEL B
	ENDIF
;
SCRCLR:	LXI	H,CLRSCR	;CLEAR TERMINAL
	CALL	MSG
;
; INITIALIZE ALL VARIABLES, POINTERS ETC. AS REQUIRED
; DEFAULT FOR BOOT IS STANDARD 3740 FORMAT. PROGRAM CHECKS DENSITY FMT CODE
; TRK 0 SEC 1 BYTE 128 FOR OTHER FORMATS
;
INIT01:	LXI	H,BIOS		;ADDR OF BIOS
	SHLD	BIOSADR		;SET ADDR VECTOR FOR INTERPRETER
	XRA	A		;DEFAULT TO 128 BYTE SECTORS
	STA	SECLEN
	MVI	A,8		;SECTORS PER TRACK
	STA	NUMSEC
	LXI	H,TRKTBL	;POINT TO DISK PARAMETER TABLE
	MVI	B,12		;LIMIT
	XRA	A
INIT02:	MOV	M,A		;STORE A ZERO
	INX	H		;INCR MEMORY POINTER
	DCR	B		;DECR COUNT
	JRNZ	INIT02		;LOOP TILL DONE
;
;		CHECK WHICH DRIVES ARE ON LINE AND INITIALIZE THEM
;
	CALL	DSKINT
	LXI	H,ONMSG
	CALL	MSG
	LDA	NUMDSK		;NUMBER OF DRIVES ON LINE
	ADI	48		;CONVERT TO ASCII
	MOV	C,A
	CALL	COUT		;PRINT IT
	LXI	H,ONMSG1
	LDA	NUMDSK
	CPI	1
	JNZ	IND11
	LXI	H,ONMSG2
IND11:	CALL	MSG		;DISK INITIALIZATION MESSAGE
	LXI	H,TRKTBL+1	;POINT TO DENSITY CODE UNIT #4
	MOV	A,M		;GET IT
	PUSH	PSW
;
	IF	DELTA		;(1791)
	CALL	DENSEL1		;SELECT DENSITY FOR READING SYSTEM.MICRO
	ENDIF
;
	IF	TARBELL		;(1791)
	MVI	C,0		;SELECT DRIVE 0 (UNIT 4)
	CALL	SELECT		;SELECTS DENSITY ALSO
	ENDIF
;
	LXI	H,ONMSG3
	CALL	MSG
	POP	PSW
	LXI	H,ONMSG5
	CPI	1
	JRZ	IND15
	LXI	H,ONMSG4
IND15:	CALL	MSG
	LXI	H,TRKTBL+2	;POINT TO SECTOR SIZE CODE
	MOV	A,M
	ANI	7FH		;SET FLAGS MASKING SIDE BIT
	LXI	H,ONMSG6
	JRZ	IND18
	LXI	H,ONMSG7
IND18:	CALL	MSG		;PRINT THE MESSAGE
	LXI	D,TRKTBL+4	;DENSITY CODE UNIT 5
	LDAX	D		;PICK UP THE CODE
	ORA	A
	JZ	MAIN		;EXIT IF ONLY ONE DRIVE
	LXI	H,ONMSG8
	CALL	MSG
	LDAX	D		;DENSITY CODE
	LXI	H,ONMSG4
	CPI	2		;SINGLE DENSITY ?
	JRZ	IND20
	LXI	H,ONMSG5
IND20:	CALL	MSG
	LXI	H,TRKTBL+5	;POINT AT SECSIZ UNIT 5
	MOV	A,M		;PICK IT UP
	ANI	7FH		;SET FLAGS MASKING SIDE BIT
	LXI	H,ONMSG6
	JRZ	IND23
	LXI	H,ONMSG7
IND23:	CALL	MSG
	JMP	MAIN		;RETURN WITH JUMP 
;
;---- READ DIRECTORY AND LOAD IN SYSTEM.MICRO ----
;
READ$DIR:			;read dir 4 blocks into buffer
				;buffer adr in HL reg
	LXI	H,BUFFER
	SHLD	UBUF		;DMA  DIRECTORY LOAD POINT
	LXI	H,800H		;LENGTH=2048 BYTES  800H
	SHLD	ULEN
	LXI	H,0002H		;STARTING BLOCK
	SHLD	UBLK
	XRA	A		;ZERO REG A
	STA	UASY
	MVI	A,1
	STA	UREQ		;READ REQUEST
	MVI	C,0		;SELECT DRIVE 0
	IF	PERSCI
	CALL	SELMOR		;MAKE SURE TABLE ENTRIES ARE RIGHT
	ELSE
	CALL	SELMORI
	ENDIF
	CALL	BIOS		;READ IN DIRECTORY
	RET
;
FIND$INTERP:			;FIND 'SYSTEM.MICRO'
*************************************************
*	replace with original from PINIT.ASM	*
*	2  lines total (excluding comments)	*
*************************************************
FI$SCH$LP:
*************************************************
*	replace with original from PINIT.ASM	*
*	4  lines total (excluding comments)	*
*************************************************
FI$CMP$LP:
*************************************************
*	replace with original from PINIT.ASM	*
*	8  lines total (excluding comments)	*
*	Replace jmp to FI$FOUND by a RET	*
*************************************************
FI$CONT:
*************************************************
*	replace with original from PINIT.ASM	*
*	6  lines total (excluding comments)	*
*************************************************
FI$HANG:			;INTERPRETER NOT THERE, GO DUMB
	LXI	H,NOMICRO
	CALL	MSG
HANG:	JMP	HANG

;
LENGTH	EQU	12		;TITLE LENGTH
SYSTLE	DB	LENGTH,'SYSTEM.MICRO'
;
;
READ$INTERP:			;PUT INTERP IN ITS PLACE
	LHLD	DENTP		;GET STARTING BLOCK
	MOV	E,M		;  INTO HL-REG
	INX	H
	MOV	D,M
	XCHG
	SHLD	UBLK		;STARTING BLOCK
	LXI	H,INTERP$BASE	;DMA LOAD POINT
	SHLD	UBUF
	LXI	H,NBLOCKS*512
	SHLD	ULEN
	MVI	C,0		;SELECT DRIVE 0
	CALL	BIOS		;READ IN INTERP
	RET
;
;
DENTP	DS	2
;
;--------- CHARACTER DRIVERS ---------------
;
; --- MESSAGE HANDLER -----
;
MSG:	MOV	A,M		;GET BYTE
	CPI	'$'		;IS IT A $
	RZ			;RETURN IF SO
	MOV	C,A
	PUSH	H		;SAVE POINTER
	CALL	COUT		;GIVE BYTE TO TERMINAL
	POP	H
	INX	H
	JMP	MSG
;
;		LOTS OF MESSAGES FOR INITIALIZE
;
NOMICRO:DB	0DH,0AH,'No SYSTEM.MICRO .....','$'
LDMSG:	DB	0DH,0AH,0AH,'LOADING...$'
RDMSG:	DB	0DH,0AH,' ERROR ATTEMPTING TO READ FMT ','$'
BADFMT:	DB	0DH,0AH,'BAD FORMAT UNIT ','$'
BADFM1:	DB	' .... PLEASE REBOOT',0DH,0AH,0AH,'$'
QUITMSG:DB	0DH,0AH,'UNIT #4 NOT READY .... PLEASE REBOOT',0DH,0AH,0AH,'$'
ONMSG:	DB	0DH,0AH,0AH,'PASCAL SYSTEM INITIALIZED FOR ','$'
ONMSG1:	DB	' DISK DRIVES',0DH,0AH,'$'
ONMSG2:	DB	' DISK DRIVE',0DH,0AH,'$'
ONMSG3:	DB	'UNIT NUMBER FOUR IS','$'
ONMSG4:	DB	' SINGLE DENSITY','$'
ONMSG5:	DB	' DOUBLE DENSITY','$'
ONMSG6:	DB	' WITH 128 BYTE SECTORS',0DH,0AH,'$'
ONMSG7:	DB	' WITH 512 BYTE SECTORS',0DH,0AH,'$'
ONMSG8:	DB	'UNIT NUMBER FIVE IS','$'
ONMSG9:	DB	0DH,0AH,'NO FMT CODE ON DISK, DO YOU WANT 3-S FORMAT (Y/N) $'
CLRSCR:	DB	27,'*',0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	DB	'$'
;				 CLEARSCREEN FOR B-4 AND HAZELTINE
;
;
;---------- DISK ROUTINES -----------
;
; HOME ALL DRIVES THAT ARE READY, THEN READ FORMAT CODE FROM TRACK
; ZERO AND INITIALIZE TRKTBL ENTRIES. FINALLY BOOT SYSTEM FROM DRIVE 0
;
DSKINT:	MVI	A,2		;MAX NUMBER OF FLOPPY DRIVES
	STA	NUMDSK		;CHECK FOR UP TO 2 DRIVES
	IF	DELTA
	OUT	WAIT+1		;SELECT SINGLE DENSITY
	ENDIF
IDSK01:	DCR	A
	STA	DSKDR		;SAVE FOR LATER
	MOV	C,A		;TO C ALSO FOR SELECT ROUTINES
	CALL	SELECT		;SELECT THE DRIVE
	IN	DSTAT		;READ DISK STATUS
	ANI	80H		;CHECK DRIVE READY
	JZ	IDSK03		;CONTINUE IF READY
	LDA	NUMDSK		;NUMBER OF DISKS
	DCR	A
	STA	NUMDSK		;REDUCE NO OF DRIVES ON LINE BY ONE
	LDA	DSKDR		;LOAD DRIVE NO
	JP	IDSK01		;LOOP IF UNIT 4 OK
	LXI	H,QUITMSG	;UNIT 4 NOT READY
	CALL	MSG
	JMP	HANG		;PROCESSOR HALT - MUST REBOOT
IDSK03:	LDA	DSKDR		;GET CURRENT DRIVE NO
	CALL	INDEX		;GET DISK PARAMETER TABLE POINTER
	XRA	A
	MOV	M,A		;SET TRACK TO ZERO
	PUSH	H		;SAVE FOR LATER
	CALL	HOME		;HOME THIS DRIVE
	MVI	A,100
	CALL	DELAY		;WAIT 100 MSEC
	CALL	RDSEC1		;READ TRACK 0 SECTOR 1
	LDA	BUFFER+7FH	;GET DENSITY CODE FROM BUFFER
;
;  CHECK FOR DOUBLE DENSITY FORMAT WITH SINGLE DENSITY CONTROLLER
	IF	NOT DELTA AND NOT TARBELL
	CPI	12H		;SINGLE SIDE DD
	JZ	IDSKERR
	CPI	92H		;DOUBLE SIDE DD
	JZ	IDSKERR
	ENDIF
;
IDSK05:	POP	H		;RESTORE POINTER TO TRACK TABLE
	INX	H		;POINT TO DENSITY
	CPI	20H		;SINGLE, SINGLE ?
	JRNZ	IDSK06
	MVI	B,2		;DENSITY
	MVI	C,0		;SECTOR SIZE
	JR	IDSK12
IDSK06:	CPI	22H		;SINGLE,SINGLE 512
	JRNZ	IDSK07
	MVI	B,2
	MVI	C,2
	JR	IDSK12
IDSK07:	CPI	0A2H		;SINGLE, TWO SIDE, 512
	JRNZ	IDSK08
	MVI	B,2
	MVI	C,80H
	JR	IDSK12
IDSK08:	CPI	12H
	JRNZ	IDSK09
	MVI	B,1		;DOUBLE DENSITY
	MVI	C,2
	JR	IDSK12
IDSK09:	CPI	92H		;DBL, DBL, 512
	JRNZ	IDSK10
	MVI	B,1
	MVI	C,0AH
	JR	IDSK12
IDSK10:	PUSH	H		;SAVE TABLE POINTER
	LXI	H,ONMSG9
	CALL	MSG
	CALL	CIN		;READ 'Y' OR 'N'
	CPI	'Y'		;ANYTHING ELSE IS NO
	MVI	C,80H		;SET DOUBLE SIDE BIT
	JRZ	IDSK11
	MVI	C,0
IDSK11:	MVI	B,2		;SINGLE DENSITY
	POP	H		;RESTORE POINTER
IDSK12:	MOV	M,B		;SAVE DENSITY CODE IN TABLE
	INX	H
	MOV	M,C		;SAVE SECTOR SIZE AND DOUBLE SIDE BIT
	LDA	DSKDR		;CURRENT DRIVE NO
	ORA	A
	JNZ	IDSK01		;CONTINUE CHECKING DRIVES TILL ZERO
	RET			;NOW READ SYSTEM.MICRO
;
;  INCORRECT FORMAT ON DISK DETECTED DURING BOOT
;
IDSKERR:LXI	H,BADFMT	;PRINT ERROR MESSAGE
	CALL	MSG
	LDA	DSKDR		;DRIVE NO
	ADI	52		;COMPUTE UNIT NO
	MOV	C,A
	CALL	COUT		;PRINT IT
	LXI	H,BADFM1
	CALL	MSG		;PRINT REST OF MESSAGE
	JMP	HANG		;AND QUIT
;
;    READ SECTOR ONE TRACK ZERO INTO BUFFER
;
RDSEC1:	LXI	H,BUFFER
	SHLD	UBUF		;MEMORY ADDR FOR READ
	LXI	H,128
	SHLD	ULEN		;NUMBER OF BYTES TO READ
	XRA	A
	STA	ERRFLG		;ZERO DISK I/O ERROR FLAG
	MVI	C,0
	CALL	SETTRK		;SET TRACK TO ZERO
	MVI	A,1
	STA	SECT		;SELECT SECTOR ONE
	CALL	READ
	LDA	ERRFLG		;CHECK ERROR FLAG
	ORA	A
	RZ
	LXI	H,RDMSG
	CALL	MSG
	JMP	HANG
;
;
;
;
;
; ***********************************************************
;
;  BIOS ROUTINES START HERE.
;
; ***********************************************************
;
;
;  PBIOS  PASCAL I-O ROUTINES       28-JULY-79
;  MODIFIED FOR DOUBLE DENSITY	    15-NOV-79
	ORG	LOADP
; 
; I/O JUMP VECTOR
BEGIN:	JMP	DSKIO	;ENTRY POINT FOR DISK DRIVERS
	JMP 	CHDRVR	;ENTRY FOR CHARACTER DRIVERS
	JMP	REMIN	;REMOTE IN
	JMP	REMOUT	;REMOTE OUT
	JMP	CONRDY	;CHECK CONSOLE READY RETURN T OR F IN A
;
IOXIT:	RET
;----- PBIOS SCRATCH AREA ------
CLAST:	DB	0
LATCH:	DB	0	;LATCH FOR CURRENT DRIVE SELECT
;
;***************** CHARACTER DRIVERS ******************
;
CHDRVR:
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	6  lines total (excluding comments)	*
*	DELETE call to CHCLR			*
*************************************************
CH01:
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	3  lines total (excluding comments)	*
*	Delete call to SETVECT			*
*************************************************
CH02:				;called $10 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	Note that original is called $10	*
*	10 lines total (excluding comments)	*
*	Don't forget to relable jumps to $10	*
*************************************************
CH03:	CALL	CIN		;DO INPUT (called $20 in original)
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	2nd thru 6th lines from $20 only	*
*	5  lines total (excluding comments)	*
*	Don't forget to relable jumps to $20	*
*************************************************
	MVI	A,03H
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	8th thru 13th lines from $20		*
*	6  lines total (excluding comments)	*
*************************************************
CH04:			;called $25 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	Starting from $25			*
*	7  lines total (excluding comments)	*
*	Don't forget to relable jumps to $25	*
*************************************************
CH05:			;called $28 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	Starting at $28				*
*	3  lines total (excluding comments)	*
*	Don't forget to relable jumps to $28	*
*************************************************
CH06:	INX	H	;called $30 in original
	JR	CH02	;don't forget to relable jumps
CHX:	JP	IOXIT
;
;CHAR IN REG C IS INTERPRETED AND OUTPUT
;
ECHO:			;same name in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	Starting at ECHO			*
*	3  lines total (excluding comments)	*
*************************************************
ECH01:			;called $10 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	Starting at $10				*
*	6  lines total (excluding comments)	*
*	Don't forget to relable jumps to $10	*
*************************************************
ECH02:			;called $20 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	first 4 lines, starting at $20		*
*	4  lines total (excluding comments)	*
*	Don't forget to relable jumps to $20	*
*************************************************
	MVI	C,32		;ASCII SPACE
	CALL	COUT
	JR	ECH02
ECH03:			;called $30 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	Starting at $30				*
*	9  lines total (excluding comments)	*
*	Don't forget to relable jumps to $30	*
*************************************************
ECH04:	CALL	COUT	;called $33 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	2nd thru 10th lines, starting from $33	*
*	9  lines total (excluding comments)	*
*	Don't forget to relable jumps to $33	*
*************************************************
	CALL	COUT
ECH05:	RET

;
; ------------ REMOTE SERIAL DRIVERS -----------
;
	IF	REMOTE		;INCLUDE ONLY IF REMOTE CONTROLLER PRESENT
REMIN:	IN	RASTAT		;CHECK STATUS
	ANI	RIMASK
	JRZ	REMIN		;WAIT TILL READY
	IN	RADATA		;GET THE DATA
	RET
;
REMOUT:	IN	RASTAT		;CHECK STATUS
	ANI	ROMASK
	JRZ	REMOUT		;WAIT TILL READY
	MOV	A,C		;GET BYTE
	OUT	RADATA
	RET
;
	ELSE
REMIN:	RET
REMOUT:	RET
	ENDIF
;
;
;------------- DISK DRIVERS -------------------
;
DSKIO:	CALL	SELDSK		;SELECT DRIVE IN REG C
	LDA	UREQ
	ANI	CLRBIT
	JRZ	CHK00
;     DONT ALLOW PASCAL TO CLEAR (HOME) DRIVES
	JP	XDSK
CHK00:	LDA	UASY
	ANI	DSKBIT		;DONT ALLOW SECTOR ACCESS
	JNZ	IOERR
CHKDSK:	LHLD	ULEN		;CHECK FOR NO BYTES
	MOV	A,H
	ORA	L
	JZ	XDSK
CHK01:	LDA	SECLEN		;CHECK WHICH MAP TO USE
	ANI	03H		;LOOK AT ONLY 2 LSB'S
	CPI	02H
	JRZ	NEWMAP
	ORA	A		;CHECK IF ZERO
	JNZ	IOERR		;ERROR IN DISK FORMAT
;
	JMP	DSK03		;STANDARD 3740 FORMAT
;
;************ MAP FOR 512 BYTE SECTORS ************
;
NEWMAP:	CALL	FRSTRK		;COMPUTE FIRST TRACK AND SEEK
	MOV	A,E		;REG E = TRACK
	STA	DTRK
; SECTOR = (BLOCK-TRACK*NUMSEC)+1
	LXI	H,0000H		;DE CONTAINS TRACK NO BEFORE ADJUSTMENT
	LDA	NUMSEC		;GET COUNTER
	MOV	B,A
MULT:	DAD	D
	DJNZ	MULT		;MULTIPLY LOOP
	XCHG			;REG DE=TRK*NUMSEC
	LHLD	UBLK		;SET UP FOR SUBTRACTION
	ANA	A		;RESET CARRY FLAG
	DSBC	DE		;SUBTRACT  HL-DE
	MOV	A,L		;REG L =SECTOR
	INR	A		;ADJUST FOR NO SECTOR 0
	STA	SECT		;SAVE SECTOR
	LDA	DTRK		;UPDATE TRACK COUNTER
	INR	A
	STA	DTRK
;------------------------------------------------
;    LOOP ON BYTES (IN ULEN)
;------------------------------------------------
NEW01:	CALL	RDWRT		;DO,I/O
	JZ	XDSK		;LEAVE IF DONE
;
;	----- CALCULATE NEXT SECTOR -----
;
	LXI	H,NUMSEC	;SETUP MEMORY POINTER
	LDA	SECT		;GET LAST SECTOR
	CMP	M		;END OF TRACK YET
	JRZ	NEWTRK		
	INR	A		;ADD ONE TO SECTOR
	STA	SECT		;NO,SAVE NEW SECTOR
	JMP	NEW01		;CONTINUE
NEWTRK:	LDA	DTRK		;GET OLD TRACK
	INR	A		;ADD ONE
	STA	DTRK
	MOV	C,A
	CALL	SETTRK		;SEEK NEW TRACK
	MVI	A,1		;UPDATE SECTOR COUNTER
	STA	SECT
	JMP	NEW01
TRKERR:	MVI	A,4		;MUST BE BAD ERROR HERE
	STA	ERRFLG
	JMP	IOXIT
;
;
;******** STANDARD MAPPING ROUTINES ************
;
;------- START INITIALIZING FOR THE LOOP --------
DSK03:	CALL	FRSTRK		;COMPUTE FIRST TRACK
	PUSH	H		;SAVE REMAINDER FROM DIVISION
	MOV	A,C
	STA	DTRK
	MVI	A,06H
	LXI	H,0000H
DSK04:			;called $20 (following DSK0 and $08-$10) in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	Starting at $20				*
*	11 lines total (excluding comments)	*
*	Don't forget to relable jumps to $20	*
*************************************************
DSK05:			;called $30 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	Starting at $30				*
*	5  lines total (excluding comments)	*
*	Don't forget to relable jumps to $30	*
*************************************************
DSK06:			;called $40 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	First 4 lines only, starting at $40	*
*	4  lines total (excluding comments)	*
*	Don't forget to relable jumps to $40	*
*************************************************
	STA	SECT
;
;----------------------------------------------
;   LOOP ON BYTES (IN ULEN)
;----------------------------------------------
DSK07:	CALL	RDWRT		;DO THE INPUT OR OUTPUT
	JZ	XDSK		;EXIT IF ULEN=0
;
;------ CALCULATE NEXT SECTOR -------
;
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	Starting 5 lines before $120		*
*	5  lines total (excluding comments)	*
*************************************************
DSK14:			;called $120 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	Starting at $120			*
*	11 lines total (excluding comments)	*
*	Don't forget to relable jumps to $120	*
*************************************************
DSK15:			;called $130 in original
*************************************************
*	Replace with original from CPMIO.TEXT	*
*	1st 5 lines of $130			*
*	5  lines total (excluding comments)	*
*	Don't forget to relable jumps to $130	*
*************************************************
	CALL	SETTRK
	POP	PSW
DSK16:	STA	DSCT0	;called $140 in original
DSK17:	STA	DSCT	;called $150 in original
	STA	SECT
	JMP	DSK07
XDSK:	JMP	IOXIT
;
; -------------------------------------------------------
;	GENERAL ROUTINES USED BY MAPPING PROCEDURES
; -------------------------------------------------------
;  
;DIVPOS - DIVIDES 2 POSITIVE INTERGERS
;     ENTRY  BC=DIVISOR  HL=DIVIDEND
;     EXIT   BC=DIVISOR  HL=REMAINDER  DE=QUOTIENT
;
DIVPOS:	LXI	D,0000H
	MVI	A,01H
DIV01:	INR	A
	SLAR	C
	RALR	B
	JP	DIV01
DIV02:	STC
	RALR	E
	RALR	D
	DSBC	BC
	JNC	DIV03
	DAD	B
	DCX	D
DIV03:	SRLR	B
	RARR	C
	DCR	A
	JRNZ	DIV02
	RALR	C
	RALR	B
	RET
;
;	RDWRT - READS OR WRITES SECTORS AND UPDATES COUNTERS
;
RDWRT:	LDA	UREQ		;READ OR WRITE FLAG
	ANI	OUTBIT		;CHECK BIT 2
	JRZ	RDWRT1		;ITS READ IF ZERO
	CALL	WRITE
	JR	RDWRT2
RDWRT1:	CALL	READ
RDWRT2:	SHLD	UBUF		;UPDATE MEMORY ADDRESS
	SDED	ULEN		;UPDATE BYTES TRANSFERRED
	MOV	A,D
	ORA	E		;READY TO TEST IF BYTE COUNT =ZERO
	RET
;
;	FRSTRK - FIRST TRACK = LOGICAL SECTOR / SECTORS PER TRACK + 1
;		(LOGICAL SECTOR = BLOCK * 512/SECTOR SIZE)
;
FRSTRK:	LHLD	UBLK		;BLOCK NO
	LDA	NUMSEC		;SECTORS PER TRACK
	CPI	26		;128 BYTE SECTORS ONLY (OTHERS 512)
	JRNZ	FRST2
	DAD	H
	DAD	H		;MULTIPLT BY 4
FRST2:	MVI	B,0
	MOV	C,A		;SECTORS PER TRACK IN BC
	CALL	DIVPOS		;DIVIDE
	MOV	C,E		;QUOTIENT
	INR	C		;ADD 1 (ADJUST FOR TRACK 0)
	CALL	SETTRK		;SEEK THE FIRST TRACK
	RET
;
;
	IF	CROMEM
;***********************************************************
;
;  PRINTER DRIVER PRINTRONIX OR CENTRONIX PARALLEL INTERFACE
;
;***********************************************************
;
LIST:	MOV	A,C
	CPI	11H	;DC1 CHAR
	JRZ	LIST4	;OVERRIDE BUSY WAIT FOR DC1, DC2 AND DEL
	CPI	13H	;DC3 CHAR
	JRZ	LIST4
	CPI	7FH	;DELETE
	JRZ	LIST4
LIST2:	IN	LSTAT	;CHECK STATUS
	ANI	LMASK
	JRNZ	LIST2	;WAIT TILL READY
LIST4:	MOV	A,C	;GET CHAR
	SETB	7,A	;CREATE CENTRONIX STROBE
	OUT	LDATA
	RES	7,A
	OUT	LDATA
	SETB	7,A
	OUT	LDATA
	RET
	ENDIF
;
;
	IF	ADM3A
; **********************************************************
;
;  ADM-3A DRIVER THIS CODE SIMULATES THE CLEAR TO END OF LINE
;  AND CLEAR TO END OF SCREEN FUNCTIONS FOR THE ADM-3A
;
; **********************************************************
;	CHARACTER EQUATES
;
NULL	EQU	0		; NULL
OTHER	EQU	0		; NULL CHARACTER
HOMCRT	EQU	30		; HOME CURSOR
RIGHT	EQU	12		; MOVE RIGHT 1 SPACE
LEFT	EQU	8		; MOVE LEFT 1 SPACE
UP	EQU	11		; MOVE UP 1 ROW
DOWN	EQU	10		; MOVE DOWN 1 ROW
EOLN	EQU	28		; CLEAR TO END OF LINE
EOSN	EQU	25		; CLEAR TO END OF SCREEN
ERASE	EQU	26		; ERASE SCREEN
SETXY	EQU	29		; SET X-Y CURSOR ADDRESS
CTLF	EQU	6		; FLUSH CHARS TO SCREEN (TOGGLE)
CTLS	EQU	19		; FREEZE CRT (TOGGLE)

;
;	CODES FOR CURSOR ACTION CONTROL TABLE (TBL1)
;
DCOL	EQU	0		; COL = COL-1
ECOL	EQU	1		; COL = COL
ICOL	EQU	2		; COL = COL + 1
ZCOL	EQU	3		; COL = 0


;
;	CONSOLE CHARACTER INPUT ROUTINE
;
CIN:	XRA	A
	STA	FFLG		; RESET FLUSH FLAG
	JMP	CONIN		; GO TO CONSOLE INPUT



;
;	CONSOLE OUTPUT DRIVER FOR PASCAL SYSTEM
;
COUT:	PUSH	H		; SAVE ENVIRONMENT
	PUSH	D
	PUSH	B
	LDA	COL
	MOV	E,A		; E = CURRENT COLUMN ADDRESS
	LXI	H,XYFLG
	MOV	A,M
	ORA	A
	JRZ	COUT1		; JUMP IF NOT PROCESSING X-Y CURSOR
	DCR	M
	JRNZ	DOROW		; ROW ADDRESS
	MOV	A,C		; GET NEW COL POSITION
	SUI	32		; REMOVE ASCII BIAS
	MOV	E,A		; UPDATE COL POSITION
DOXY:	CALL	CONOUT		; POSITION CURSOR
	JR	EXIT0
DOROW:	MOV	A,C		; ROW INDEX
	SUI	32		; ASCII BIAS
	CPI	24		; LIMIT
	JM	DOROW1		; DO NOT ALLOW SCREEN WRAP AROUND
	MVI	C,'7'		; ROW 23
	MVI	A,23
DOROW1:	STA	ROW		; SAVE ROW INDEX
	JR	DOXY
;
COUT1:	PUSH	B		; SAVE CHARACTER
	MOV	A,C
	LXI	H,CTBLND
	LXI	B,CTBLSZ
	CCDR			; SEARCH CHARACTER TABLE
	LXI	H,TBL1
	DAD	B		; H/L =ADR IN CHARACTER ACTION TABLE
	MOV	A,M		; A = ACTION BYTE
	ANI	3
	DCR	A
	CPI	ZCOL-1		; ZERO COLUMN IF NECESSARY
	JRNZ	YC1
	XRA	A
	MOV	E,A
YC1:	ADD	E		; ADD IN COLUMN OFFSET
	MOV	E,A
	LXI	H,TBL2
	DAD	B
	DAD	B
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A		; H/L = ADR OF PROCESSING ROUTINE FOR CHARACTER
	POP	B		; CHAR RESTORED TO C REG
	PCHL			; BYE
;
;	PROCESS X-Y CURSOR POSITIONING REQUEST
;
GOXY:	LXI	H,XYFLG
	MVI	M,2		; COUNT FOR X, Y ADR BYTES
	MVI	C,1BH		; ESCAPE
	CALL	CONOUT
	MVI	C,'='		; ESCAPE EQUALS SEQUENCE LOADS CURSOR
	JR	PUT
;
;	PROCESS TAB EXPANSION TO BLANKS
;
TABOUT:	MVI	C,RIGHT
XT0:	CALL	CONOUT
	INR	E		; INCREMENT COL, STOP AT NEXT TAB STOP
	MOV	A,E
	ANI	7
	JRNZ	XT0
	JR	EXIT0
;
;	OUTPUT CHAR IN C WITH ROW PROCESSING
;
PUTH:	XRA	A		; ZERO
	JR	PUTLF1		; ROW ZERO FOR HOME
PUTRLF:	LDA	ROW
	DCR	A		; DECR ROW INDEX
	JP	PUTRLF1
	XRA	A		; SET ROW TO ZERO IF PAST TOP OF SCREEN
PUTRLF1:JR	PUTLF1
PUTLF:	LDA	ROW
	INR	A		; INCR ROW INDEX
	CPI	24		; MAX ROW IS 23
	JM	PUTLF1
	MVI	A,23
PUTLF1:	STA	ROW		; SAVE ROW INDEX
;
;	OUTPUT CHAR IN REG C
;
PUT:	CALL	CONOUT
;
;	TEST AND UPDATE COL POSITION FROM REG E
;
EXIT0:	MOV	A,E
	ORA	A		;CHECK IF MOVED TO HIGHER LINE
	JP	YE0
	XRA	A		;FORM CURSOR ADDR 0..79
YE0:	CPI	80		;CHECK IF MOVED TO LOWER LINE
	JRC	XE1
	MVI	A,79		; NO AUTO LINE FEED
XE1:	STA	COL		; SAVE COL ADDRESS
;
;	RESTORE REGISTERS AND EXIT
;
EXIT1:	POP	B
	POP	D
	POP	H
	MOV	A,C
	RET
;
;
RESET:	CALL	CLRLN		; CALL CLEAR TO END OF LINE
	JR	EXIT0
;
CLRLN:	MVI	C,' '		; SPACE TO CLEAR END OF LINE
	MVI	A,80		; COL LIMIT
	SUB	E
	JRZ	XR1		; CONTINUE IF COL 80
	MOV	B,A		; SPACE COUNT TO B
XR0:	CALL	CONOUT		; PRINT A SPACE
	DJNZ	XR0		; LOOP TILL END OF LINE
XR1:	MVI	C,0DH
	CALL	CONOUT		; REPOSITION CURSOR ON ORIGINAL LINE
	MVI	C,RIGHT		; FORWARD SPACE
	MOV	B,E		; COL POSITION TO B
	MOV	A,B
	ORA	A
	RZ			; EXIT IF AT COL 0
XR2:	CALL	CONOUT
	DJNZ	XR2		; FORWARD SPACE TILL BACK TO ORIG POSITION
	RET
;
;	CLEAR TO END OF SCREEN 
;
CLRS:	CALL	CLRLN		; CLEAR TO END OF FIRST LINE
	LXI	H,ROW		; POINT TO ROW INDEX
	MVI	A,23		; ROW LIMIT
	SUB	M		; SUBTRACT ROW INDEX
	JZ	EXIT0		; EXIT IF ALREADY ON LAST ROW
	MOV	B,A		; COUNT OF ROWS TO CLEAR
	MVI	C,0DH		; CARRIAGE RET
	CALL	CONOUT		; PRINT IT
	MOV	C,E		; SAVE COL INDEX IN C
	MVI	E,0		; SET COL TO ZERO
CLRS2:	PUSH	B		; SAVE INDICES
	MVI	C,0AH		; LINE FEED
	CALL	CONOUT
	CALL	CLRLN		; CLEAR THE LINE
	POP	B		; RESTORE INDICES
	DJNZ	CLRS2		; LOOP TILL B IS ZERO
	MOV	E,C		; RESTORE COL INDEX
	MVI	C,1BH		; ESCAPE
	CALL	CONOUT
	MVI	C,'='		; EQUALS
	CALL	CONOUT
	LDA	ROW
	MOV	C,A
	CALL	CONOUT		; PRINT ROW
	MOV	A,E		; COL INDEX
	ADI	32		; ASCII BIAS
	MOV	C,A
	CALL	CONOUT		; PRINT COL
	JMP	EXIT0
;
;	SPECIAL CHARACTER TABLE
;
CHRTBL:	DB	OTHER		; NON-SPECIAL CHARACTER
	DB	NULL		; NULL CHARACTER
	DB	HOMCRT		; HOME CURSOR
	DB	RIGHT		; MOVE CURSOR RIGHT 1 SPACE
	DB	LEFT		; MOVE CURSOR LEFT 1 SPACE
	DB	UP		; MOVE CURSOR UP 1 SPACE
	DB	DOWN		; MOVE CURSOR DOWN 1 SPACE
	DB	CR		; CARRIAGE RETURN
	DB	EOLN		; ERASE TO END OF LINE
	DB	EOSN		; ERASE TO END OF SCREEN
	DB	ERASE		; ERASE SCREEN, HOME CURSOR
	DB	SETXY		; SET CURSOR ADDRESS
CTBLND:	DB	TAB		; MOVE TO NEXT TAB STOP
CTBLSZ	EQU	$-CHRTBL	; NUMBER OF ENTRIES IN TABLE
;
;	CURSOR MOTION AND LEAD IN TABLE
;
TBL1:	DB	ICOL		; NOTHING SPECIAL
	DB	ECOL		; NULL
	DB	ZCOL		; HOME
	DB	ICOL		; RIGHT
	DB	DCOL		; LEFT
	DB	ECOL		; UP
	DB	ECOL		; DOWN
	DB	ZCOL		; CR
	DB	ECOL		; EOLN
	DB	ECOL		; EOSN
	DB	ZCOL		; ERASE
	DB	ECOL		; SET X-Y ADDRESS
	DB	ECOL		; TAB (PROCESSING ROUTINE HANDLES COLUMN)
;
;	CHARACTER DISPATCH TABLE
;
TBL2:	DW	PUT		; NON-SPECIAL CHARACTER
	DW	PUT		; NULL
	DW	PUTH		; HOME
	DW	PUT		; RIGHT
	DW	PUT		; LEFT
	DW	PUTRLF		; UP
	DW	PUTLF		; DOWN
	DW	PUT		; CR
	DW	RESET		; EOLN
	DW	CLRS		; EOSN
	DW	PUTH		; ERASE
	DW	GOXY		; SET X-Y ADDRESS
	DW	TABOUT		; TAB
;
;	STORAGE LOCATIONS
;
COL:	DB	0		; CURRENT COLUMN
ROW:	DB	0		; CURRENT ROW
FFLG:	DB	0		; FLUSH FLAG
XYFLG:	DB	0		; X-Y FLAG (INITIALLY RESET)
ATOGL:	DB	20H		; UPPER-LOWER CASE TOGGLE ON ^A
PFLG:	DB	0		; PRINT (ECHO) FLAG

CONST:	IN	3
	ANI	2
	RZ
	MVI	A,0FFH
	RET

CONIN:	IN	3
	ANI	2
	JRZ	CONIN
	IN	2
	ANI	7FH	; REMOVE PARITY BIT
	CPI	1	; CONTROL A
	JRNZ	CONIN4
	LDA	ATOGL	; TOGGLE LOWER CASE SWITCH
	XRI	20H
	STA	ATOGL
	MVI	A,1	; RETURN A CONTROL A
	RET
CONIN4:	MOV	C,A	; SAVE CHAR IN C
	CPI	61H	; LOWER CASE A
	JM	CONIN6	; EXIT IF < A
	CPI	7BH	; LOWER CASE Z + 1
	JP	CONIN6	; EXIT IF > Z
	LDA	ATOGL	; LOAD LOWER CASE SWITCH
	XRA	C	; EXCLUSIVE OR WITH CHAR
	RET
CONIN6:	MOV	A,C	; RESTORE CHAR TO A
	RET

CONOUT:	IN	3
	ANI	1
	JRZ	CONOUT
	MOV	A,C	; GET OUTPUT CHAR
	OUT	2
	RET
	ENDIF
;
;
;
	IF	SOROC
; ************************************************************
;
; SOROC AND OTHER TERMINALS NOT REQUIRING COMPLEX SOFTWARE 
; DRIVERS USE THIS CODE
;
; *************************************************************
;
;   ---- READ A CHARACTER FROM KEYBOARD ----
CIN:	IN	TSTAT	;READ STATUS
	ANI	IMSK01
	JRZ	CIN
	IN	PORT01	;GET CHAR
	ANI	7FH	;REMOVE BIT 7
	RET
; 
;   ----- WRITE CHARACTER IN REG C TO SOROC TERMINAL  -----
;
COUT:	LDA	UNIT
	CPI	06H
	JRZ	LIST
	MOV	A,C
	CPI	CR	;IS IT A CR
	JRZ	CURET	;YES,THEN CHECK IF TO FREEZE VIDEO
CHOUT:	IN	TSTAT	; GIVE CHAR TO TERMINAL
	ANI	OMSK01
	JRZ	CHOUT	;WAIT FOR UART OR USART
	MOV	A,C	;GET CHAR
	OUT	PORT01
	RET
;
; CARRAGE RETURN- CHECK IF CRT IS TO BE STOPPED - CTRL S
;
CURET:	IN	TSTAT
	ANI	IMSK01
	JRZ	CHOUT
	IN	PORT01
	ANI	7FH
	CPI	CTRLS
	JRNZ	CHOUT
CRLOOP	CALL	CIN
	CPI	CTRLS
	JRZ	CHOUT
	JR	CRLOOP
	ENDIF
;
;
	IF	BASIC4		;BASIC 4 TERMINALS 4FDC CONTROLLER
;
; ************************************************************
;
; BASIC 4 SLOW TERMINAL REQUIRES LONG DELAY AFTER VERTICAL MOVE
;
; *************************************************************
;
;   ---- READ A CHARACTER FROM KEYBOARD ----
;
CIN:	IN	TSTAT	;READ STATUS
	ANI	IMSK01
	JRZ	CIN
	IN	PORT01	;GET CHAR
	ANI	7FH	;REMOVE BIT 7
	RET
; 
;   ----- WRITE CHARACTER IN REG C TO BASIC4 TERMINAL  -----
;
COUT:	MOV	A,C		;CHAR TO PRINT
	CPI	CR
	JRNZ	COUT1
	XRA	A
	STA	COLNUM		;RESET COLUMN TO ZERO
	JZ	COUT3
COUT1:	CPI	TAB
	CZ	TABEXP		;EXPAND TABS
	CPI	20H		;PRINTABLE CHARACTER
	JRC	COUT3		;NON PRINTING CHAR
	LDA	COLNUM
	INR	A
	STA	COLNUM		;INCR COLUMN POSITION
COUT3:	LDA	UNIT
	CPI	06H
	JRZ	LIST
	MOV	A,C
	CPI	CR		;IS IT A CR
	JRZ	CURET		;YES,THEN CHECK IF TO FREEZE VIDEO
CHOUT:	IN	TSTAT		; GIVE CHAR TO TERMINAL
	ANI	OMSK01
	JRZ	CHOUT	;WAIT FOR UART
	MOV	A,C	;GET CHAR
	OUT	PORT01
	CPI	0AH	;IS IT A LINE FEED
	CZ	DLY	;DELAY
	CPI	ESC	;IS IT AN ESCAPE
	JRNZ	CHOUTX
	STA	ESCFLG	;STORE IT
	RET		;JUST RETURN IF ESCAPE
CHOUTX:	LDA	ESCFLG	;CHECK LAST CHAR = ESCAPE
	CPI	ESC
	CZ	CHKTIME	;CHECK IF TIME DELAY REQUIRED
	XRA	A
	STA	ESCFLG	;SET ESCAPE FLAG TO ZERO
	RET
;
; CARRAGE RETURN- CHECK IF CRT IS TO BE STOPPED - CTRL S
;
CURET:	IN	TSTAT
	ANI	IMSK01
	JRZ	CHOUT
	IN	PORT01
	ANI	7FH
	CPI	CTRLS
	JRNZ	CHOUT
CRLOOP:	CALL	CIN
	CPI	CTRLS
	JRZ	CHOUT
	JR	CRLOOP
;
;  CHECK FOR CHARACTERS CAUSING VERTICAL MOVE DELAY AND WAIT 16 MSEC
;
CHKTIME:MOV	A,C	;LAST CHAR OUTPUT TO A
	CPI	'*'	;CLEAR SCREEN
	JRZ	DLY	;DELAY
	CPI	'Y'	;CLEAR TO END OF SCREEN
	JRZ	DLY	;DELAY
	CPI	':'	;INSERT LINE
	JRZ	DLY	;DELAY
	CPI	'+'	;DELETE LINE
	JRZ	DLY	;DELAY
	CPI	'Y'	;CLEAR TO END OF LINE
	JRZ	DLY	;DELAY
	RET
DLY:	MVI	A,13
	CALL	DELAY	;WAIT 13 MSEC
	RET
;
;	---- EXPAND TABS FOR BOTH PRINTER AND TERMINAL ----
;
TABEXP:	LDA	COLNUM		;COLUMN NUMBER
	ANI	7H		;CHECK LAST 3 BITS
	RZ
	INR	A		;INCREMENT IT
	STA	COLNUM		;SAVE IT BACK
	LDA	UNIT		;TERMINAL OR PRINTER
	CPI	6
	MVI	C,20H		;GET A SPACE READY FOR OUTPUT
	CZ	LIST
	CALL	CHOUT		;TERMINAL
	JR	TABEXP
;
;
ESCFLG	DB	0
COLNUM	DB	0
;
	ENDIF
;
;***********************************************************
;
;  CONSOLE READY ROUTINE - RETURNS TRUE OR FALSE FOR CHAR READY
;
;
CONRDY:	IN	TSTAT		;READ STATUS
	ANI	IMSK01
	RZ			;FALSE, NO CHAR WAITING
	CMA			;MAKE IT TRUE
	RET
;
;
;************************************************************
;
;   DISK DRIVERS	TARBELL, DELTA AND CROMEMCO CONTROLLERS
;
;************************************************************
;
;   ----- SELECT DISK ,NUMBER IN REG. C -----
;
SELDSK:	MOV	A,C		;GET NEW DISK NUMBER.
	ANI	3		;ONLY LOOK AT 2 LSBS
	MOV	C,A
	LDA	DSKDR		;CURRENTLY SELECTED DRIVE
	CMP	C		;COMPARE WITH NEW DRIVE
	RZ			;IF SAME, RETURN.
	LDA	NUMDSK		;NUMBER OF DRIVES ON LINE
	DCR	A		;SUBTRACT 1 TO GET MAXIMUM DR CODE
	CMP	C		;NEWDRIVE > NUMDISKS ?
	JP	SELMOR
;
;IO ERROR EXIT FOR UNRECOVERABLE IO ERRORS,SET ERROR FLAG
;
IOERR:	MVI	A,4		;DISK ERROR FLAG
	STA	ERRFLG		;PUT IN FLAG
	RET
;
	IF	PERSCI		;DON'T UPDATE TRACK POSITION, SAME FOR ALL
SELMOR:	MOV	A,C		;NEW DRIVE NO
	STA	DSKDR		;SAVE IT
	CALL	INDEX		;POINT TO DRIVE PARAMETERS
	INX	H		;POINT TO DENSITY CODE
	ELSE
SELMOR:	LDA	DSKDR		;UP DATE TRACK TABLE
	CALL	INDEX		;FIND TABLE ENTRY FOR DRIVE PARAMETERS
	IN	TRACK
	MOV	M,A		;SAVE IT IN TABLE
SELMORI:MOV	A,C		;GET NEW DRIVE
	STA	DSKDR		;SAVE IN DISKDR
	CALL	INDEX		;FIND PARAMETERS FOR NEW DRIVE
	MOV	A,M		;GET LAST TRACK POSITION
	OUT	TRACK		;UPDATE 1791 TRACK REGISTER
	INX	H		;POINT TO DENSITY CODE IN TABLE
	ENDIF
;
	IF	DELTA		;(1791)
	CALL	SELECT		;DRIVE NO IS IN C
	CALL	DENSEL		;SELECT IT AND SET SECLEN
	ENDIF
;
	IF	TARBELL		;(1791)
	CALL	SELECT		;SELECT BOTH DRIVE AND DENSITY FOR TARBELL
	ENDIF
;
	IF	NOT DELTA AND NOT TARBELL	;(1771)
	CALL	SELECT
	ENDIF
;
SELEND:	MVI	A,50
	CALL	DELAY		;DELAY 50 MSEC FOR HEAD SETTLE
	INX	H		;POINT TO SECSIZE CODE IN TABLE
	MOV	A,M		;GET SECTOR LENGTH CODE
	ORA	A		;SET FLAGS (DBLSID WILL BE MINUS)
	MVI	A,0		;FALSE
	JP	SELMOR0
	MVI	A,0FFH		;TRUE
SELMOR0:STA	DBLSID		;SET DOUBLE SIDE FLAG
	MOV	A,M		;GET SECTOR LENGTH AGAIN
	ANI	7FH		;MASK OFF SIDE BIT
	STA	SECLEN
	ORA	A
	MVI	A,26		;128 BYTE SECTORS SINGLE DENSITY
	JRZ	SELMOR1		;26 SECTORS IF ZERO
	MVI	A,8		;512 BYTE SECTORS SINGLE DENSITY
SELMOR1:STA	NUMSEC		;SET IT
	DCX	H		;POINT TO DENSITY
	MOV	A,M		;PICK UP CODE
	CPI	2
	RZ			;RETURN IF SINGLE DENSITY
	MVI	A,16
	STA	NUMSEC		;MUST BE 16 SECTORS DOUBLE DENSITY
	RET
;
;
;
;  INDEX PUTS ADDR OF START OF DISK DRIVE PARAMETER BLOCK IN HL
;  INDEX IS CALLED WITH THE DRIVE NUMBER IN A
;
INDEX:	LXI	H,TRKTBL
	MOV	E,A		;SAVE A COPY OF REG A
	ADD	A		;FIGURE OFFSET INTO TABLE
	ADD	E
	MOV	E,A		;ADD OFFSET TO BASE
	MVI	D,00
	DAD	D
	RET
;
;  SELECT WILL SELECT THE DISK IN C FOR APPROPRIATE CONTROLLER
;
	IF	DELTA		;(1791)
SELECT:	MOV	A,C		;DRIVE NO TO A
	CMA			;COMPLIMENT IT
	OUT	DCONT		;ISSUE COMMAND
	RET
	ENDIF
;
	IF	TARBELL		;(1791)
SELECT:	MOV	A,M		;PICK UP DENSITY CODE
	ADD	A
	ADD	A
	ADD	A		;SHIFT LEFT 3 BITS
	ANI	8		;MASK OFF TARBELL DD BIT
	MOV	B,A		;SAVE IN B FOR LATER
	MOV	A,C		;GET DRIVE NUMBER
	ADD	A
	ADD	A
	ADD	A
	ADD	A		;SHIFT LEFT 4
	ORA	B		;ADD IN THE SINGLE/DOUBLE DENSITY BIT
	OUT	DCONT		;ISSUE COMMAND
	MOV	A,B		;GET BACK DENSITY BIT
	ORA	A		;CHECK FOR ZERO (SINGLE DENSITY)
	RZ
	MVI	A,2		;IF NOT SET SECLEN AND NUMSEC
	STA	SECLEN
	MVI	A,16
	STA	NUMSEC		;16 SECTORS PER TRACK DOUBLE DENSITY
	RET
	ENDIF
;
	IF	OLDTARB		;(1771)
SELECT:	MOV	A,C		;GET DRIVE NO
	CMA			;COMPLIMENT IT
	ADD	A
	ADD	A
	ADD	A
	ADD	A		;SHIFT LEFT FOUR
	ORI	02H
	STA	LATCH		;SAVE IN LATCH
	OUT	DCONT		;ISSUE COMMAND
	RET
	ENDIF
;
	IF	C4FDC		;CROMEMCO 4FDC CONTROLLER (1771)
SELECT:	INR	C		;ADD 1 TO DRIVE NO
	XRA	A		;START WITH ZERO
	STC			;SET CARRY
SEL1A:	RAL			;SHIFT RIGHT 1
	DCR	C
	JNZ	SEL1A		;COUNT NO OF SHIFTS
	ORI	30H		;OR IN PERSCI MOTOR ON AND 8 IN DISK BITS
	STA	LATCH
	OUT	WAIT		;SELECT DISK
	RET
	ENDIF
;
;  DENSEL SELECTS DENSITY, CODE IN (HL) 1=DOUBLE DENSITY 2=SINGLE DENSITY
;
	IF	DELTA
DENSEL:	MOV	A,M		;GET THE DENSITY CODE
DENSEL1:OUT	WAIT+1		;SENT CODE TO DENSITY PORT
	RET
	ENDIF
;
;
;READ  READ THE SECTOR IN (SECT),FROM PRESENT TRACK
;USE STARTING ADDRESS IN (UBUF).
;
READ:	MVI	A,RTCNT
RRETRY:	STA	ERCNT	;STORE IN ERROR CTR.
	MVI	A,0D0H
	OUT	DCOM	;INTERRUPT CONTROLLER
	LXI	H,RDDONE
	PUSH	H	;SET UP RETURN ADDR
	LHLD	UBUF	;GET STARTING ADR.
	LDED	ULEN	;BYTES TO DO
	MVI	C,DDATA	;DISK DATA PORT
	XTHL
	XTHL		;SHORT DELAY
	IF	C4FDC
	IN	WAIT	;CHECK HEAD LOAD BIT
	ELSE
	IN	DSTAT	;READ STATUS.
	ENDIF
	ANI	20H	;LOOK AT HLD BIT.
	LDA	SECT	;GET SECTOR NUMBER.
	OUT	SECTP	;SET SECTOR INTO 1771.
	MVI	A,8CH	;READ WITH HEAD LOAD
	JRZ	READE	;HEAD NOT LOADED.
	MVI	A,88H	;CODE FOR READ W/O HD LD.
READE:	OUT	DCOM	;SEND COMMAND TO 1771.
RLOOP:	IN	WAIT	;WAIT FOR DRQ OR INTRQ.
	IF	C4FDC
	ANI	81H
	JZ	RLOOP	;WAIT FOR INTRQ OR DRQ
	RRC
	RC		;BIT ZERO IS INTRQ
	ELSE
	ORA	A		;SET FLAGS.
	RP		;DONE IF INTRQ.
	ENDIF
	INI		;READ FROM DISK INTO (HL)
	DCX	D	;DECREASE BYTE COUNTER
	MOV	A,D	;AND CHECK FOR 0
	ORA	E
	JNZ	RLOOP	;KEEP READING
	POP	B	;FIX UP STACK
RDLP02:	CALL	BUSY
	ANI	18H
	JRNZ	CHECK
	RET
RDDONE:	IN	DSTAT	;READ DISK STATUS
	ANI	9DH	;LOOK AT ERROR BITS.
	RZ		;RETURN IF NONE.
CHECK:	CALL	ERCHK	;CHECK FOR SEEK ERROR.
	LDA	ERCNT	;GET ERROR COUNT.
	DCR	A	;DECREMENT COUNT.
	JRNZ	RRETRY	;TRY TO READ AGAIN.
	JMP	IOERR	;READ DISK ERROR
;
;ERROR CHECK  CHECK FOR RECORD NOT FOUND ERROR,AND SEEK TO
;CORRECT TRACK IF REQUIRED.
;
ERCHK:	ANI	10H
	RZ		;NOT SEEK ERROR
	CALL	IDREAD	;READ TRACK ADDRESS
	LDA	IDTAB
	MOV	C,A	;SAVE TRACK
	IN	TRACK	;CHECK 1771 TRACK REG
	CMP	C	;IF SAME,NO ERROR
	RZ
	MOV	A,C	;PUT CORRECT TRACK IN 1771
	OUT	TRACK
	LDA	TRK	;GET TRACK WANTED
	MOV	C,A
	CALL	SEEK	;AND GO TO IT
	RET
;
;WRITE  WRITE THE SECTOR IN (SECT),FROM PRESENT TRACK
;USE STARTING ADDRESS IN (UBUF)
;
WRITE:	MVI	A,RTCNT
WRETRY:	STA	ERCNT	;STORE IN ERROR COUNTER.
	MVI	A,0D0H	;CAUSE INTERUPT
	OUT	DCOM
	LXI	H,WDONE
	PUSH	H	;SET UP RETURN ADDR
	LHLD	UBUF	;GET STARTING ADR
	LDED	ULEN	;BYTES TO DO
	MVI	C,DDATA	;DISK DATA PORT
	XTHL
	XTHL		;SHORT DELAY
	IF	C4FDC
	IN	WAIT	;CHECK HEAD LOAD BIT
	ELSE
	IN	DSTAT	;GET 1771 STATUS.
	ENDIF
	ANI	20H	;CHECK FOR HEAD LOAD.
	LDA	SECT	;GET SECTOR NUMBER.
WRITE1:	OUT	SECTP	;SET THE SECTOR INTO 1771.
	MVI	A,0ACH	;SET UP 1771 FOR WRITE.
	JRZ	WRITE2	;HEAD IS NOT LOADED
	MVI	A,0A8H	;CODE FOR WRITE W/O HD LD.
WRITE2:	OUT	DCOM
WLOOP:	IN	WAIT	;WAIT FOR READY.
	IF	C4FDC
	ANI	81H
	JZ	WLOOP	;WAIT TILL INTRQ OR DRQ
	RRC
	RC		;BIT ZERO IS INTRQ
	ELSE
	ORA	A	;SET FLAGS.
	RP		;HOP OUT WHEN DONE.
	ENDIF
	OUTI		;WRITE TO DISK FROM (HL)
	DCX	D	;DECREASE BYTE COUNTER
	MOV	A,D	;AND CHECK FOR 0
	ORA	E
	JNZ	WLOOP	;KEEP WRITING.
	POP	B	;FIX UP STACK
WRT02:	CALL	BUSY
	ANI	18H	;DONT LOOK AT LOST DATA BIT
	JRNZ	PROCER
	RET
WDONE:	MVI	A,100
WDONE1:	DCR	A
	JRNZ	WDONE1	;WRITE DELAY FOR PERSCI 299 DRIVES
	IN	DSTAT	;READ DISK STATUS
	ANI	0FDH	;LOOK AT THESE BITS.
	RZ		;RETURN IF NO ERRORS
PROCER:	CALL	ERCHK	;CHECK/CORRECT SEEK ERROR
	LDA	ERCNT	;GET ERROR COUNT.
	DCR	A	;DECREMENT COUNT.
	JNZ	WRETRY	;TRY TO WRITE AGAIN.
	JMP	IOERR	;WRITE DISK ERROR
;
;HOME  MOVES HEAD TO TRACK ZERO.USES RESTORE COMMAND,NO HDL
;
	IF	C4FDC
HOME:	MVI	A,7FH
	OUT	4		;TURN OFF HIGH SPEED SEEK
	MVI	A,08H
	OUT	DCOM
HOM1:	IN	WAIT
	ANI	81H
	JZ	HOM1		;WAIT TILL COMPLETE
	IN	DSTAT		;READ STATUS
	ANI	99H
	JRNZ	HOME
	MVI	A,6FH
	OUT	4		;TURN SEEK BACK ON
	RET
	ELSE
HOME:	MVI	A,0D0H		;CAUSE INTERUPT
	OUT	DCOM	
	CALL	BUSY
	MVI	A,01H		;RESTORE,NO HDL,NO VERIFY
	OUT	DCOM
	CALL	BUSY
	IN	DSTAT
	ANI	04H		;MAKE SURE IT'S HOMED
	JRZ	HOME
	RET
	ENDIF
;
;
;SET TRACK  CHECK IF TRACK IN REG C IS EQUAL TO PRESENT
;TRACK,AND MOVE TO NEW TRACK IF NOT.
;CALLABLE ROUTINES:
;SEEK:MOVES HEAD TO TRACK IN REG A
;
SETTRK:	IN	TRACK
	MOV	B,A		;SAVE PRESENT TRACK IN B
	CMP	C		;COMPARE WITH NEW TRACK
	RZ			;GO BACK IF SAME
;
	IF	NOT PERSCI
SEEK:	MOV	A,C		;MOVE TRACK TO SEEK TO 
	OUT	DDATA
	STA	TRK		;DO UPDATING WHILE WAITING FOR 1791
	CALL	BUSY		;WAIT UNTIL 1791 NOT BUSY
	MVI	A,18H+STEP
	OUT	DCOM		;SEEK COMMAND,NO VERIFY,WITH HDL
	IN	WAIT
	MOV	A,C		;DEST TRACK
	SUB	B		;COMPARE WITH STARTING TRACK
	CPI	1		;DID WE STEP JUST ONE TRACK
	MVI	A,10		;WAIT 10 MSEC IF ONE TRACK
	JRZ	SEEK1
	MVI	A,20		;OTHERWISE WAIT 20 MSEC
SEEK1:	CALL	DELAY
	RET
	ENDIF
;
	IF	PERSCI AND C4FDC
SEEK:	MOV	A,C		;TRACK NO TO A
	OUT	DDATA		;SET TRACK INTO 1771
	STA	TRK		;SAVE TRACK NO
	CALL	BUSY
	MVI	A,18H		;SEEK WITH HEAD LOAD
	OUT	DCOM		;ISSUE IT
	MVI	A,1
	CALL	DELAY		;WAIT 1 MSEC BEFORE TESTING SEEK COMPLETE
SEEK2Z:	IN	4		;4FDC COMMAND PORT
	ANI	40H		;SEEK COMPLETE BIT
	JRNZ	SEEK2Z		;WAIT TILL COMPLETE
	MOV	A,C		;DEST TRACK
	SUB	B		;STARTING TRACK
	CPI	1		;DID WE STEP JUST ONE TRACK
	MVI	A,10		;DELAY 10 MSEC
	JRZ	SEEK1
	MVI	A,36
SEEK1:	CALL	DELAY		;WAIT 36 MSEC FOR HEAD SETTLE
	RET
	ENDIF
;
	IF	PERSCI AND NOT C4FDC
SEEK:	MVI	A,48H+STEP	;STEP IN WITH HEAD LOAD
	JC	SDIR		;STEP IN IF MINUS
	MVI	A,68H+STEP	;STEP OUT WITH HEAD LOAD
SDIR:	OUT	DCOM		;ISSUE STEP COMMAND
	MVI	A,20
DLOOP:	DCR	A		;SHORT DELAY LOOP
	JNZ	DLOOP
	MOV	A,B		;GET PRESENT TRACK
	SUB	C		;CALC REQUIRED NUMBER OF STEPS
	JP	STEP0		;CHECK PLUS OR MINUS
	CMA			;COMPLIMENT IF MINUS
	INR	A		;TWO'S COMP
STEP0:	MOV	B,A		;STEPS TO B
	MVI	A,1		;PERSCI STEP COMMAND
STEP1:	OUT	DCONT		;ISSUE PERSCI STEP
	DCR	B		;COUNT DOWN NO OF STEPS
	JNZ	STEP1		;LOOP TILL STEPS DOWN TO ZERO
	IN	WAIT		;CLEAR 1791
	IN	DSTAT		;READ STATUS
	MOV	A,C		;GET DESTINATION TRACK
	OUT	TRACK		;UPDATE TRACK REGISTER
	LDA	LATCH		;SELECT LATCH CODE
	ANI	72H		;MAKE SEEK COMPLETE COMMAND
	OUT	DCONT		;ISSUE IT
	IN	WAIT		;WAIT TILL SEEK COMPLETE
	LDA	LATCH		;GET BACK LATCH
	OUT	DCONT		;RESTORE OLD LATCH CODE
	MOV	A,C		;DEST TRACK
	SUB	B		;STARTING TRACK
	CPI	1		;DID WE STEP JUST ONE TRACK
	MVI	A,10		;DELAY 10 MSEC
	JRZ	SEEK1
	MVI	A,30
SEEK1:	CALL	DELAY		;WAIT 30 MSEC AFTER SEEK
	RET
	ENDIF
;
;BUSY  CHECKS 1791 FOR BUSY,RETURNS WHEN NOT BUSY
;
BUSY:	MVI	A,6		;ALLOW 12 MICRO SEC SETTLE TIME
BUSY1:	DCR	A
	JNZ	BUSY1
BUSY2:	IN	DSTAT		;GET 1791 STATUS
	RRC			;CHECK BIT 0
	JC	BUSY2		;not done, continue
	RAL			;PUT BITS BACK
	RET
;
;
;  TIMED DELAY LOOP. CALLED WITH NO OF MSEC DELAY IN A 
;
DELAY:	PUSH	D
	PUSH	H
DSTART:	LXI	D,1
	LXI	H,65355		;CONST FOR 1 MSEC DELAY
DLOOP:	DAD	D
	JRNC	DLOOP		;LOOP TILL CARRY (5.5 USEC/ITERATION)
	DCR	A		;DECR MSEC COUNT
	JRNZ	DSTART
	POP	H
	POP	D
	RET
;
;
;ID READ  READS THE ID FIELD ON CURRENT TRACK,AND PUTS DATA
;INTO IDTAB. USED TO DETERMINE SECTOR LENGTH,AND CURRENT TRACK
;
IDREAD:	IN	TRACK
	ORA	A		;MAY HAVE DIFFERENT FORMAT
	JRNZ	IDRD00
	INR	A		;MOVE TO TRACK 1
	CALL	SEEK
IDRD00:	MVI	A,RTCNT
IDRD01:	STA	IDECNT
	MVI	A,0D0H
	OUT	DCOM
	LXI	H,IDTAB
	CALL	BUSY
	MVI	A,0C4H		;READ ADDRESS COMMAND
	OUT	DCOM
IDRD02:	IN	WAIT		;WAIT FOR DATA OR INTER
	IF	C4FDC
	ANI	81H
	JZ	IDRD02		;WAIT FOR INTRQ OR DRQ
	RRC			;SHIFT INTRQ BIT RIGHT
	JC	IDRD03		;FINISHED
	ELSE
	ORA	A
	JP	IDRD03
	ENDIF
	IN	DDATA
	MOV	M,A		;PUT BYTE IN TO TABLE
	INX	H
	JMP	IDRD02
IDRD03:	IN	DSTAT
	ANI	08H
	RZ
	LDA	IDECNT
	DCR	A
	JRNZ	IDRD01		;TRY AGAIN
	JMP	IOERR		;ID READ ERROR


IDECNT:	DB	0		;RETRY COUNTER
;IDTAB				;TRACK NO (EQUATED TO LOW MEMORY)
IDTAB1	EQU	IDTAB+1		;ZERO
IDTAB2	EQU	IDTAB+2		;SECTOR NO
IDTAB3	EQU	IDTAB+3
IDTAB4	EQU	IDTAB+4		;CRC
IDTAB5	EQU	IDTAB+5		;CRC
;
         END