
;	SYSTEM SOFTWARE FOR COMPUCOLOR II

;	MAY 18,1978 - VERSION 6.78

;	COPYRIGHT (C) 1978 BY COMPUCOLOR CORP.


SYSORG	EQU	211CH	;ROM ORG FOR SYSTEM

DSBUFS	EQU	32*64*2	;NOLIN*NOCHAR*2
DSBUF	EQU	6000H	;START ADDRESS OF DISPLAY FAST RAM
X80	EQU	DSBUF+DSBUFS ; START OF DISPLAY SLOW RAM

STACK	EQU	8042H	;STACK FROM SCREEN TO HERE
LINBF	EQU	8046H	;BASIC LINE BUFFER
TRAM	EQU	80DEH	;TEMP RAM START IN BASIC RAM
ORAM	EQU	80F0H	;FCS RAM
CRTRAM	EQU	81AFH	;CRT RAM


	ORG	6000H	;BASIC ADDRESSES
	DW	CMPDH
	DW	SUBHD
	DW	MOVDH
	DW	MOVHD
	DW	CMPHD
	DW	ADHLA
	DW	ANHD
	DW	NEGH
	DW	NOTH
	DW	ORHD
	DW	XORHD
	DW	SHLHD
	DW	SHRHD
	DW	MULHD
	DW	DIVHD
	DW	SPNOR
	DW	EMESS
	DW	WF2
	DW	RF2
	DW	CHDLR
	DW	PFSPC
	DW	OPENX
	DW	RESET
	DW	WR
	DW	RD
	DW	CLX


	ORG	STACK
SBC:	DS	1	;SECTOR BYTE COUNT FOR DISK
CRC1:	DS	1	;1ST CRC BYTE FOR DISK
CRC2:	DS	1	;2ND CRC BYTE FOR DISK

	ORG	LINBF
	DS	1	;FOR BASIC'S ","
BUFP:	DS	59	;FCS LINE BUFFER
ZRAM:	DS	39	;FCS STUFF / BASIC INPUT BUFFER
	ORG	$	;*** SHOULD EQUAL "X20A" IN BASIC ***



; *** COMPUCOLOR DISK HANDLER ***
; *** VERSION FOR USE WITH COMPUCOLOR II ***
;
; COPYRIGHT (C) 1978
; BY INTELLIGENT SYSTEMS CORPORATION
;

; CONSTANTS :

NSEC	EQU	10	;NUMBER OF SECTORS / TRACK
NTRK	EQU	41	;NUMBER OF TRACKS
STPTIM	EQU	20	;STEP TIME / 0.5 MS.
UPTIM	EQU	1600	;MOTOR UP-TO-SPEED TIME / 0.5 MS.
FILL	EQU	0FFH	;"FILL" BYTE
IDM	EQU	55H	;ID MARK
DATAM	EQU	5AH	;DATA MARK

RGAPS	EQU	3	;BYTE TIMES / GAP CONFIRMATION

WRTR	EQU	4	;WRITE/VERIFY RETRY COUNT
VRTR	EQU	2	;VERIFY RETRY COUNT
RRTR	EQU	10	;READ RETRY COUNT
SRTR	EQU	3*NSEC	;SEARCH TRY COUNT
HRTR	EQU	3*NSEC	;HEADER RETRY COUNT


; "TEMP" RAM ALLOCATION :

	ORG	TRAM

TEMPHL:	DS	2	;TEMP REG FOR HL
BRTRY:	DS	1	;BLOCK RETRY COUNTER
RFLG:	DS	1	;"RESTORE" FLAG / COUNTER
CRTRY:	DS	1	;"CHUNK" RETRY COUNTER
OBC:	DS	2	;OLD BYTE COUNT

TFCN:	DS	1	;FUNCTION CODE
TDRV:	DS	1	;DRIVE NUMBER
TBLK:	DS	2	;BLOCK NUMBER
TMEM:	DS	2	;MEMORY BUFFER POINTER
TBC:	DS	2	;BYTE COUNT

OSEC:	DS	1	;OLD SECTOR NUMBER
SEC:	DS	1	;SECTOR NUMBER
TRK:	DS	1	;TRACK NUMBER
	ORG	$	;*** SHOULD NOT BE PAST "ORAM" ***




; COMPUCOLOR DISK HANDLER :


	ORG	SYSORG

CDHD:	XCHG
	LHLD	CDNM	;GET NAME
	XCHG
	LDA	CDNU	;GET NUMBER OF UNITS
	CALL	BSB01	;COPY PARAMETERS & SETUP RETURN
	PUSH	PSW	;SAVE FLAGS
	LXI	H,0
	MOV	D,H
	LDA	CDSEC	;GET NUMBER OF SECTORS
	MOV	E,A	;E=NUMBER OF SECTORS / TRACK
	MVI	A,NTRK-1 ; NO. OF TRACKS USED FOR DATA
DX10:	DAD	D	;ADD SECTORS AGAIN
	DCR	A	;ENOUGH ?
	JNZ	DX10	;NO: LOOP
	POP	PSW	;RESTORE FLAGS
	JP	XFER	;IT IS READ OF WRITE
	SHLD	TBLK	;SAVE TOTAL NUMBER OF BLOCKS
	INR	A	;"GET SIZE" FUNCTION ?
	RZ		;YES: EXIT
	INR	A	;"ADD USER" FUNCTION ?
	JNZ	DX11	;NO
ADDU:	CALL	GCUCNT	;HL => CUCNT0 OR CUCNT1
	INR	M	;INCREMENT USER COUNT
	RET		;EXIT

DX11:	INR	A	;"SUBTRACT USER" FUNCTION ?
	JNZ	CDRSET	;NO: MUST BE "TURN OFF" FUNCTION
SUBU:	CALL	GCUCNT	;HL => CUCNT0 OR CUCNT1
	DCR	M	;SUBTRACT A USER
	JP	DX12	;O.K. 
TOFF:	CALL	GCUCNT	;HL => CUCNT0 OR CUCNT1
	MVI	M,0	;SET ZERO USERS
DX12:	PUSH	B
	MOV	A,M	;GET USER COUNT
	ANA	A	;TEST IT
	JNZ	DX13	;NOT ZERO 
	CALL	DX14A	;WAIT FOR BUFFERS TO EMPTY
	CALL	VTP	;ARE TRACK & PHASE VALID ?
	XRA	A
	CALL	STEPS	;MOVE HEAD TO HOME
DX13:	XRA	A	;NO REASON
	OUT	EXTOT	;DESELECT DRIVE
	MVI	A,16	;WAIT ONE CHARACTER TIME ...
DX13A:	DCR	A
	JNZ	DX13A
	DI
	MVI	A,10H
	OUT	MASK	;MASK SERIAL IN ONLY
	IN	RSTBF	;"CLEAR" RECVR INTERUPT
	LDA	RCOMD	;PICK UP HI/LO RATE COMND
	OUT	COMND	;ISSUE
	LDA	CRATE	;PICK UP CURRENT RATE
	OUT	BAUD	;ISSUE
	LDA	CMASK
	OUT	MASK	;RESTORE 5501 MASK
	POP	B
	EI
	RET		;EXIT 

CDRSET:	XRA	A
	STA	TDRV	;SET DRIVE ZERO
	CALL	TOFF	;PARK DRIVE ZERO
	MVI	A,1
	STA	TDRV	;SET DRIVE ONE
	JMP	TOFF	;PARK DRIVE ONE AND EXIT

XFER:	MOV	A,E	;NO. OF SECTORS
	CMA
	INR	A
	MOV	C,A	;C= - NO. OF SECTORS
	XCHG		;D&E=TOTAL NUMBER OF BLOCKS
	LHLD	TBLK	;GET BLOCK NUMBER
	CALL	CMPHD	;IS IT VALID ?
	MVI	B,EBLK	;SET ERROR CODE
	RNC		;ERROR: INVALID BLOCK
	MVI	B,-1	;SET HI BYTE OF B&C
	XRA	A	;CLEAR A
DX14:	INR	A	;COUNT TRACK
	DAD	B	;SUBTRACT SECTORS / TRACK
	JC	DX14	;LOOP
	MOV	H,A	;MOVE TRACK NUMBER TO H
	MOV	A,L	;GET LO BYTE
	SUB	C	;ADJUST
	MOV	L,A	;SET SECTOR NUMBER
	SHLD	SEC	;SAVE TRACK & SECTOR
	CALL	ADDU	;"ADD A USER"
	CALL	DX14A	;WAIT TIL CHAR FINISHED
	CALL	DXX	;PERFORM READ OR WRITE
	JMP	SUBU	;SUBTRACT USER AND EXIT

DX14A:	LDA	CDMK
	OUT	MASK	;SET 5501 MASK FOR EXTERNAL SENSOR ONLY
	LDA	CRATE	;GET 5501 CURRENT RATE
	RLC		;GET RID OF STOP BIT BIT
	LXI	H,1	;INITIALIZE DELAY NEEDED
	MVI	B,4	;INITIALIZE COUNTER
DX15:	RLC		;GET NEXT BIT
	JC	DX16	;FOUND THE RATE 
	DAD	H	;DOUBLE THE DELAY NEEDED
	DCR	B	;AGAIN ?
	JNZ	DX15	;YES 
	DAD	H	;DOUBLE THE DELAY NEEDED
	RLC		;GET NEXT BIT
	JC	DX16	;FOUND THE RATE 
	DAD	H	;DOUBLE THE DELAY NEEDED
	RLC		;GET NEXT BIT
	JC	DX16	;FOUND THE RATE 
	MVI	L,96	;IT MUST BE 110 BAUD: SET DELAY NEEDED

DX16:			;WAIT FOR BUFFERS TO EMPTY :

DX17:	LDA	RCOMD	;GET RATE COMMAND
	ANI	10H	;MASK OFF HI-RATE BIT
	JZ	DX18	;LO-RATE: USE ZERO COUNTER 
	MVI	A,32	;HI-RATE: USE PROPER COUNTER
DX18:	DCR	A	;ENOUGH ?
	JNZ	DX18	;NO: LOOP 
	DCR	L	;ENOUGH ?
	JNZ	DX17	;NO: LOOP 

	MVI	A,18H
	OUT	COMND	;SET HIGH SPEED
	MVI	A,0C0H
	OUT	BAUD	;SET RATE = 76.8 KBAUD
	RET

DXX:	CALL	VTP	;POUND HOME IF NEEDED
	CALL	GCTRK	;HL => CTRK0 OR CTRK1
	MOV	H,M	;GET CURRENT TRACK NUMBER
	LDA	CDK	;GET UPTIM/STPTIM
	MOV	L,A	;SAVE IT
	LDA	TRK	;GET DESIRED TRACK NUMBER
	SUB	H	;COMPUTE POSITIVE DIFFERENCE ...
	JP	CD03
	CMA
	INR	A
CD03:	SUB	L	;COMPUTE -(ADDITIONAL STEP DELAYS NEEDED)
	JP	SEEK	;NO ADDITIONAL DELAY NEEDED 
CD04:	PUSH	PSW	;SAVE COUNT
	CALL	STPWAT	;DELAY ONE STEP TIME
	POP	PSW	;RESTORE COUNT
	INR	A	;ENOUGH ?
	JNZ	CD04	;NO: WAIT AGAIN 

SEEK:	EI		;*** ENABLE INTERRUPTS ***
	LDA	TRK	;GET DESIRED TRACK NUMBER
	CALL	STEPS	;MOVE HEAD TO DESIRED TRACK

	LDA	SEC	;GET CURRENT SECTOR NUMBER
	STA	OSEC	;SAVE IT FOR VERIFY PASS
	LHLD	TBC	;GET CURRENT BYTE COUNT
	SHLD	OBC	;SAVE IT FOR VERIFY PASS

ISEC:	EI		;*** ENABLE INTERRUPTS ***
	LXI	H,RFLG	;HL => RESTORE FLAG / RETRY COUNTER
	MOV	A,M	;GET FLAG
	ANA	A	;HAVE WE DONE A RESTORE ?
	JZ	IS1	;NO: LEAVE FLAG ALONE 
	MVI	M,3	;INITIALIZE WIGGLE COUNTER
IS1:

	LHLD	TBC	;GET REMAINING BYTE COUNT
	MVI	A,80H	;DETERMINE SECTOR BYTE COUNT ...
	ANA	L
	ORA	H
	MVI	A,80H
	JNZ	IS2	;FULL SECTOR (128.) REQUIRED 
	MOV	A,L	;PARTIAL SECTOR BYTE COUNT
IS2:	STA	SBC	;SAVE SECTOR BYTE COUNT

	LDA	TFCN	;GET FUNCTION CODE
	DCR	A	;TEST IT
	MVI	A,RRTR	;SET RETRY COUNT
	JM	IS4	;FUNCTION IS READ 

	CALL	CRCX	;COMPUTE CRC FOR SECTOR
	XCHG
	SHLD	CRC1	;SAVE CRC BYTES
	MVI	A,WRTR	;SET WRITE RETRY COUNT
	STA	CRTRY
IS3:	MVI	A,VRTR	;SET VERIFY RETRY COUNT ...
IS4:	STA	BRTRY	;INITIALIZE RETRY COUNT

DSEC:	MVI	C,SRTR	;INITIALIZE SEARCH TRY COUNT
FG0:	MVI	B,HRTR	;INITIALIZE HEADER RETRY COUNT
FG1:	IN	RXBUF	;CLEAR RECEIVER BUFFER
	MVI	L,RGAPS+1 ; SET NO. BYTE TIMES / GAP
FG2:	IN	STAT5	;GET 5501 STATUS
	ANI	8	;HAS A BYTE BEEN RECEIVED ?
	JNZ	FG1	;YES: RESET & TRY AGAIN 
	DCR	L	;HAS GAP BEEN CONFIRMED ?
	JZ	FG4	;YES 
	MVI	A,16	;WAIT ONE BYTE TIME ....
FG3:	DCR	A
	JNZ	FG3
	JMP	FG2	;GO CHECK AGAIN 
FG4:			;GAP HAS BEEN FOUND

	DI		;*** DISABLE INTERRUPTS ***
	LXI	D,0FFFFH ; INITIALIZE CRC RESIDUE
	CALL	RBYTEC	;READ ID MARK
	CPI	IDM	;IS IT CORRECT ?
	JNZ	HER1	;NO 
	CALL	RBYTEC	;READ TRACK NUMBER
	MOV	H,A	;SAVE IT
	CALL	RBYTEC	;READ SECTOR NUMBER
	MOV	L,A	;SAVE IT
	CALL	RBYTEC	;READ 1ST CRC BYTE
	CALL	RBYTEC	;READ 2ND CRC BYTE
	MOV	A,D
	ORA	E	;IS CRC CORRECT ?
	JZ	GH1	;YES: GOT A GOOD HEADER 
HER1:	EI		;*** ENABLE INTERRUPTS ***
	DCR	B	;HEADER RETRIES EXHAUSTED ?
	JNZ	FG1	;NO: TRY READING HEADER AGAIN 

SEEKF:	EI		;*** ENABLE INTERRUPTS ***
	MVI	B,ESKF	;SET ERROR CODE
	LDA	RFLG	;GET "RESTORE" FLAG
	ANA	A	;HAVE WE ALREADY DONE A RESTORE ?
	JNZ	WIG1	;YES: WIGGLE OR GIVE UP 
	CALL	POUND	;POUND TO HOME
	JMP	SEEK	;NOW SEEK DESIRED TRACK 

WIG1:	LXI	H,RFLG	;HL => RESTORE FLAG / WIGGLE COUNTER
	DCR	M	;UPDATE & TEST FLAG
	RZ		;ERROR EXIT 
	JP	WIG2	;COUNTER IS O.K. 
	MVI	M,2	;SET COUNTER CORRECTLY
WIG2:	MOV	A,M	;GET COUNTER
	DCR	A	;TEST IT
	JZ	WIG3	;2ND WIGGLE: IN-OUT
	CALL	STPOUT	;STEP OUT
	CALL	STPIN	;STEP IN
	JMP	IS1	;GO TRY AGAIN 
WIG3:	CALL	STPIN	;STEP IN
	CALL	STPOUT	;STEP OUT
	JMP	IS1	;GO TRY AGAIN 

GH1:	LDA	TRK	;GET DESIRED TRACK
	CMP	H	;CORRECT TRACK ?
	JNZ	SEEKF	;NO 
GH2:	LDA	SEC	;GET DESIRED SECTOR
	CMP	L	;CORRECT SECTOR ?
	JZ	GH4	;YES: DO IT 
GH3:	EI		;*** ENABLE INTERRUPTS ***
	DCR	C	;SEARCH TRIES EXHAUSTED ?
	JNZ	FG0	;NO: TRY AGAIN 
	MVI	B,ECFB	;SET POSSIBLE ERROR CODE
	JMP	WIG1	;GO WIGGLE OR GIVE UP 

GH4:	LDA	SBC	;GET SECTOR BYTE COUNT
	MOV	B,A
	LHLD	TMEM	;GET BUFFER POINTER
	LDA	TFCN	;GET FUNCTION CODE
	DCR	A	;TEST FUNCTION CODE
	JM	RD00	;COMMAND IS READ 
	DCR	A
	JNZ	WR00	;COMMAND IS WRITE 

VE00:	CALL	GDATAM	;CONFIRM DATA MARK
	JZ	VE02	;GOT IT 
VERR:	EI		;*** ENABLE INTERRUPTS ***
	LXI	H,BRTRY	;POINT TO VERIFY RETRY COUNTER
	DCR	M	;VERIFY RETRIES EXHAUSTED ?
	JNZ	DSEC	;NO: TRY AGAIN 
	MVI	A,3
	STA	TFCN	;SET REWRITE FUNCTION CODE
	LXI	H,CRTRY	;POINT TO WRITE RETRY COUNTER
	DCR	M	;WRITE RETRIES EXHAUSTED ?
	JNZ	IS3	;NO: GO WRITE SECTOR AGAIN 
	MVI	B,EVFY	;SET ERROR CODE
	RET		;ERROR: VERIFY FAILURE 

VE01:	CALL	RBYTE	;READ NEXT DATA BYTE
	XRA	M	;"XOR" WITH MEMORY BYTE
	JNZ	VERR	;VERIFY ERROR 
	INX	H	;BUMP MEMORY PNTR
VE02:	DCR	B	;ANY DATA LEFT ?
	JP	VE01	;YES: LOOP 
	LDA	SBC	;GET SECTOR BYTE COUNT
	DCR	A	;ADJUST
	MOV	B,A	;B=TRAILER COUNTER (^ TO 80H)
	JMP	VE04	;GO CHECK TRAILERS IF ANY 

VE03:	CALL	RBYTE	;READ NEXT TRAILER BYTE
	ANA	A	;IT SHOULD BE ZERO
	JNZ	VERR	;VERIFY ERROR 
VE04:	INR	B	;ANY TRAILERS LEFT ?
	JP	VE03	;YES: LOOP 

	PUSH	H	;SAVE MEMORY POINTER
	CALL	RBYTE	;READ 1ST CRC BYTE
	MOV	E,A
	CALL	RBYTE	;READ 2ND CRC BYTE
	MOV	D,A
	LHLD	CRC1	;GET CORRECT CRC BYTES
	CALL	CMPHD	;COMPARE CRC BYTES
	POP	H	;RESTORE MEMORY POINTER
	JNZ	VERR	;VERIFY ERROR 

ESEC:	SHLD	TMEM	;SAVE MEMORY POINTER
	LHLD	TBLK	;GET BLOCK NUMBER
	INX	H	;INCREMENT IT
	SHLD	TBLK	;SAVE UPDATED BLOCK NUMBER
	LHLD	TBC	;GET BYTE COUNT
	LXI	D,-128
	DAD	D	;SUBTRACT ONE SECTOR
	JC	BS13	;LAST SECTOR WAS NOT PARTIAL 
	LXI	H,0	;SET BYTE COUNT = 0
BS13:	SHLD	TBC	;SAVE UPDATED BYTE COUNT
	MOV	A,H	;TEST NEW BYTE COUNT ...
	ORA	L
	JNZ	BS10	;MORE TO DO
	LDA	TFCN	;GET FUNCTION CODE
	DCR	A	;"WRITE" FUNCTION ?
	JZ	BS11	;YES: GO VERIFY
	MVI	B,0	;SET "GOOD" STATUS CODE
	EI		;*** ENABLE INTERRUPTS ***
	RET		;FINISHED

BS10:	LXI	H,SEC	;POINT TO CURRENT SECTOR
	INR	M	;INCREMENT TO NEXT SECTOR
	LDA	CDSEC	;GET NO. OF SECTORS
	CMP	M	;OVERFLOW TO NEXT TRACK ?
	JNZ	ISEC	;NO: GO DO NEXT SECTOR
BS11:	CALL	BSB08	;SETUP
	JC	BS12	;RESET SECTOR
	MVI	M,0	;SET SECTOR = ZERO
	INX	H	;POINT TO TRACK
	INR	M	;INCREMENT TRACK
	MVI	A,NTRK	;GET HIGHEST TRACK NUMBER PLUS ONE
	CMP	M	;IS IT VALID ?
	JNZ	SEEK	;YES: GO START NEXT TRACK 
	MVI	B,EBLK	;SET ERROR CODE
	EI		;*** ENABLE INTERRUPTS ***
	RET		;ERROR EXIT: INVALID BLOCK NUMBER 

BS12:	LDA	OSEC	;GET OLD SECTOR
	STA	SEC	;RESET SECTOR
	JMP	ISEC	;GO DO NEXT SECTOR

WR00:	PUSH	H
	CALL	GXOUT	;HL => XOUT0 OR XOUT1
	MOV	A,M	;GET PHASE
	ORI	08H	;SET WRITE BIT
	MOV	E,A	;COPY IT
	CALL	SXO	;SEND TO DRIVE
	POP	H
	MVI	A,FILL
	CALL	WBYTE	;WRITE A FILL BYTE
	MVI	A,DATAM
	CALL	WBYTE	;WRITE DATA MARK
	JMP	WR02	;GO WRITE DATA IF ANY 

WR01:	MOV	A,M	;GET NEXT BYTE FROM MEMORY
	INX	H	;BUMP BUFFER POINTER
	CALL	WBYTE	;WRITE DATA BYTE
WR02:	DCR	B	;ANY DATA LEFT ?
	JP	WR01	;YES: LOOP
	LDA	SBC	;GET SECTOR BYTE COUNT
	DCR	A	;ADJUST
	MOV	B,A	;B=TRAILER COUNTER (^ TO 80H)
	JMP	WR04	;GO WRITE TRAILERS IF ANY 

WR03:	XRA	A	;CLEAR A REGISTER
	CALL	WBYTE	;WRITE A ZERO TRAILER BYTE
WR04:	INR	B	;ANY TRAILERS LEFT TO DO ?
	JP	WR03	;YES: LOOP 

	LDA	CRC1
	CALL	WBYTE	;WRITE 1ST CRC BYTE
	LDA	CRC2
	CALL	WBYTE	;WRITE 2ND CRC BYTE

	MVI	A,32	;WAIT FOR BUFFERS TO EMPTY (2 BYTE TIMES) ....
WR05:	DCR	A
	JNZ	WR05
	MVI	A,1AH	;INTERUPT ACKNOWLEDGE BIT SET 
	OUT	COMND	;SET TX LINE TO "SPACING"
	MVI	A,2	;DELAY A FEW BIT TIMES ....
WR06:	DCR	A
	JNZ	WR06
	PUSH	H
	CALL	GXOUT	;HL => XOUT0 OR XOUT1
	MOV	E,M	;GET PHASE
	CALL	SXO	;DISABLE WRITE CIRCUITRY
	POP	H
	MVI	A,18H	;INTERUPT ACKNOWLEDGE BIT SET 
	OUT	COMND	;SET TX LINE TO "MARKING"

	LDA	TFCN	;GET FUNCTION CODE
	DCR	A	;TEST IT
	JZ	ESEC	;NORMAL WRITE: WRAP-UP 
	MVI	A,2
	STA	TFCN	;SET FUNCTION BACK TO VERIFY
	EI		;*** ENABLE INTERRUPTS ***
	JMP	DSEC	;NOW GO VERIFY AGAIN 

RD00:	CALL	GDATAM	;CONFIRM DATA MARK
	JZ	RD02	;GOT IT 
	MVI	B,EDSY	;SET POSSIBLE ERROR CODE
	JMP	RERR

RD01:	CALL	RBYTE	;READ NEXT DATA BYTE
	MOV	M,A	;STORE THE BYTE
	XRA	M	;"XOR" BACK FROM MEMORY
	INX	H	;BUMP MEMORY PNTR
	JZ	RD02	;O.K. 
	MVI	B,EMEM	;SET ERROR CODE
	EI		;*** ENABLE INTERRUPTS ***
	RET		;MEMORY ERROR 
RD02:	DCR	B	;ANY DATA LEFT ?
	JP	RD01	;YES: LOOP 
	LDA	SBC	;GET SECTOR BYTE COUNT
	DCR	A	;ADJUST
	MOV	B,A	;B=TRAILER COUNT (^ TO 80H)
	JMP	RD04	;GO CHECK TRAILERS IF ANY 

RD03:	CALL	RBYTE	;READ NEXT TRAILER BYTE
RD04:	INR	B	;ANY TRAILERS LEFT ?
	JP	RD03	;YES: LOOP 

	PUSH	H	;SAVE MEMORY POINTER
	CALL	RBYTE	;READ 1ST CRC BYTE
	MOV	L,A
	CALL	RBYTE	;READ 2ND CRC BYTE
	MOV	H,A
	PUSH	H	;SAVE CRC BYTES
	CALL	CRCX	;COMPUTE CRC FOR SECTOR
	POP	H	;RESTORE CRC BYTES
	CALL	CMPHD	;COMPARE CRC BYTES
	POP	H	;RESTORE MEMORY POINTER
	JZ	ESEC	;NO ERRORS 
	MVI	B,EDCS	;SET POSSIBLE ERROR CODE
RERR:	EI		;*** ENABLE INTERRUPTS ***
	LXI	H,BRTRY	;POINT TO READ RETRY COUNTER
	DCR	M	;RETRIES EXHAUSTED ?
	JNZ	DSEC	;NO: TRY AGAIN 
	JMP	WIG1	;GO WIGGLE MAYBE 


WBYTE:	MOV	C,A
WB1:	IN	STAT5	;GET 5501 STATUS
	ANI	10H	;READY ?
	JZ	WB1	;NO: WAIT 
	MOV	A,C
	OUT	TXBUF	;SEND THE BYTE
	RET		;EXIT 

RBYTE:	IN	STAT5	;GET 5501 STATUS
	ANI	08H	;GOT A BYTE ?
	JZ	RBYTE	;NO: WAIT 
	IN	RXBUF	;READ THE BYTE
	RET		;EXIT 

RBYTEC:	IN	STAT5	;GET 5501 STATUS
	ANI	08H	;GOT A BYTE ?
	JZ	RBYTEC	;NO: WAIT 
	IN	RXBUF	;READ THE BYTE

CRC:	PUSH	PSW
	PUSH	H
	XRA	E
	MOV	H,A
	RRC
	RRC
	RRC
	RRC
	ANI	0FH
	XRA	H
	MOV	L,A
	RRC
	RRC
	RRC
	MOV	H,A
	ANI	1FH
	XRA	D
	MOV	E,A
	MOV	A,H
	ANI	0E0H
	XRA	L
	MOV	D,A
	MOV	A,H
	RRC
	ANI	0F0H
	XRA	E
	MOV	E,A
	POP	H
	POP	PSW
	RET

CRCX:	LDA	SBC	;GET SECTOR BYTE COUNT
	MOV	B,A	;B=DATA BYTE COUNTER
	DCR	A
	MOV	C,A	;C="TRAILER" COUNTER (^ TO 80H)
	LXI	D,0FFFFH ; INITIALIZE CRC RESIDUE
	LHLD	TMEM	;GET MEMORY POINTER
	MVI	A,DATAM	;DATA MARK
	CALL	CRC	;UPDATE CRC RESIDUE
	JMP	CR2
CR1:	MOV	A,M	;GET NEXT BYTE
	INX	H	;BUMP MEMORY POINTER
	CALL	CRC	;UPDATE CRC RESIDUE
CR2:	DCR	B	;ANY MORE DATA ?
	JP	CR1	;YES: LOOP 
	JMP	CR4
CR3:	XRA	A
	CALL	CRC	;UPDATE CRC RESIDUE
CR4:	INR	C	;ANY TRAILERS LEFT ?
	JP	CR3	;YES: LOOP 
	RET	;DE = CRC 


GDATAM:	CALL	RBYTE	;READ GARBAGE BYTE
	CALL	RBYTE	;READ NEXT BYTE
	CPI	DATAM	;DATA MARK ?
	RZ		;YES 
	CALL	RBYTE	;READ NEXT BYTE
	CPI	DATAM	;DATA MARK ?
	RZ		;YES 
	CALL	RBYTE	;READ NEXT BYTE
	CPI	DATAM	;DATA MARK ?
	RET		;<Z>: O.K., <NZ>: ERROR 


VTP:	XRA	A	;NO COMMENT
	STA	RFLG	;CLEAR RESTORE FLAG
	CALL	GCTRK	;HL => CTRK0 OR CRTK1
	MOV	A,M	;GET SUPPOSED CURRENT TRACK
	CPI	NTRK	;IS IT VALID ?
	JNC	POUND	;NO: GO POUND 
	ADI	2	;ADJUST TRACK NUMBER
VTP1:	SUI	3	;"MOD" TRACK NUMBER ...
	JP	VTP1	;... BY 3
	MOV	E,A
	MVI	A,8
VTP2:	RRC
	INR	E
	JNZ	VTP2
	MOV	E,A	;E=CORRECT PHASE FOR SUPPOSED TRACK
	CALL	GXOUT	;HL => XOUT0 OR XOUT1
	MOV	A,M	;GET SUPPOSED PHASE
	CMP	E	;CHECK IF IT'S CORRECT
	JNZ	POUND	;NOT CORRECT: GO POUND 
SXO:	LDA	TDRV	;GET DRIVE NUMBER
	ANA	A	;TEST DRIVE NUMBER
	MVI	A,10H	;SELECT BIT FOR DRIVE ZERO
	JZ	SXO1	;SELECT BIT IS CORRECT 
	RLC		;CHANGE TO SELECT BIT FOR DRIVE ONE
SXO1:	ORA	E	;MERGE
	OUT	EXTOT	;SELECT DRIVE AND MOTOR ON
	STC		;SET CARRY
	RET		;RETURN <C>: NO POUND 

POUND:	CALL	GXOUT	;HL => XOUT0 OR XOUT1
	MVI	E,4	;SET PHASE
	MOV	M,E	;STORE IT
	CALL	SXO	;SEND TO DRIVE
	MVI	A,3
	STA	RFLG	;SET WIGGLE COUNTER
	CALL	GCTRK	;HL => CTRK0 OR CTRK1
	MVI	M,42	;SET CURRENT TRACK NUMBER
	XRA	A	;SET TRACK ZERO

STEPS:	MOV	B,A	;B=DESIRED TRACK
	CALL	GCTRK	;HL => CTRK0 OR CTRK1
STP1:	MOV	A,B	;GET DESIRED TRACK
	CMP	M	;COMPARE WITH CURRENT TRACK
	RZ		;WE ARE THERE: EXIT 
	JC	STP2	;NEED TO STEP OUT 
	INR	M	;UPDATE CURRENT TRACK
	CALL	STPIN	;STEP IN ONE TRACK
	JMP	STP1	;SEE IF WE'RE THERE NOW 
STP2:	DCR	M	;UPDATE CURRENT TRACK
	CALL	STPOUT	;STEP OUT ONE TRACK
	JMP	STP1	;SEE IF WE'RE THERE NOW 

STPIN:	PUSH	H
	CALL	GXOUT	;HL => XOUT0 OR XOUT1
	MOV	A,M	;GET PHASE
	RLC		;SHIFT PHASE LEFT ONE
	CPI	8	;SHIFT OUT ?
	JC	STP3	;NO: GO STEP 
	MVI	A,1	;RESET TO PHASE ZERO
	JMP	STP3	;GO STEP 

STPOUT:	PUSH	H
	CALL	GXOUT	;HL => XOUT0 OR XOUT1
	MOV	A,M	;GET PHASE
	RRC		;SHIFT PHASE RIGHT ONE
	JNC	STP3	;GO STEP 
	MVI	A,4	;RESET TO PHASE TWO
STP3:	MOV	M,A	;STORE PHASE BYTE
	MOV	E,A	;COPY PHASE BYTE
	CALL	SXO	;SEND TO DRIVE
	POP	H

STPWAT:	LDA	STEPCD	;STEP RATE FOR CHEAP DISK
	JMP	WATS	;DELAY ONE STEP TIME & RETURN

GXOUT:	LXI	H,XOUT0
	JMP	WXYZ

GCTRK:	LXI	H,CTRK0
	JMP	WXYZ

GCUCNT:	LXI	H,CUCNT0
WXYZ:	LDA	TDRV
	ANA	A
	RZ
	INX	H
	RET


; ************************************************

;FILE CONTROL SYSTEM - VERSION 3.0

;COPYRIGHT (C) 1977,1978
; BY INTELLIGENT SYSTEMS CORPORATION
;



; COMMAND TABLE:

CMTAB:	DB	'INI'
	DW	INI00
	DB	'DIR'
	DW	DIR00
	DB	'SAV'
	DW	SAV00
	DB	'LOA'
	DW	LOA00
	DB	'RUN'
	DW	RUN00
	DB	'DEL'
	DW	DEL00
	DB	'REN'
	DW	REN00
	DB	'COP'
	DW	COP00
	DB	'DUP'
	DW	DUP00
	DB	'DEV'
	DW	DEV00
	DB	'REA'
	DW	REA00
	DB	'WRI'
	DW	WRI00
	DB	0	;TERMINATOR 
	FCSORG	EQU	$	;SET FOR CONTINUATION

; OPEN TYPE CODE BIT DEFINITIONS :

FNEW	EQU	01H	;0: OLD FILE, 1: NEW FILE


; DIRECTORY ENTRY TYPE CODE BIT DEFINITIONS :

TFREE	EQU	01H	;"FREE SPACE" ENTRY - BYTE VALUE

TPROT	EQU	01H	;PROTECTED FILE
TFILE	EQU	02H	;PERMANENT FILE ENTRY


; RAM ALLOCATION :

	ORG	ZRAM

ZFPB:	DS	1
ZFATR:	DS	1
ZFNAM:	DS	6
ZFTYP:	DS	3
ZFVER:	DS	1
ZFSBK:	DS	2
ZFSIZ:	DS	2
ZFLBC:	DS	1
ZFLAD:	DS	2
ZFSAD:	DS	2
	DS	1
ZFDBK:	DS	1
ZFDEN:	DS	1
ZFAUX:	DS	2
ZFHAN:	DS	2
ZFFCN:	DS	1
ZFDRV:	DS	1
ZFBLK:	DS	2
ZFBUF:	DS	2
ZFXBC:	DS	2
ZFPTR:	DS	2
ZFPBE:	;END OF AUX. FPB, END OF BASIC INPUT BUFFER

	ORG	ORAM

DFDV:	DS	2	;DEFAULT DEVICE (ASCII)
DFUN:	DS	1	;DEFAULT UNIT (ASCII)

FPBP:	DS	2	;FILE PARAMETER BLOCK POINTER
OCODE:	DS	1	;OPEN TYPE CODE
OVERS:	DS	1	;ORIGINAL VERSION

; SYSTEM FILE PARAMETER BLOCK ALLOCATION :

FPB:	DS	1	;OPEN TYPE CODE
FATR:	DS	1	;ATTRIBUTE BYTE
FNAM:	DS	6	;FILE NAME
FTYP:	DS	3	;FILE TYPE
FVER:	DS	1	;FILE VERSION NUMBER
FSBK:	DS	2	;STARTING BLOCK NUMBER
FSIZ:	DS	2	;NUMBER OF BLOCKS
FLBC:	DS	1	;BYTE COUNT OF LAST BLOCK
FLAD:	DS	2	;LOAD ADR. FOR "IMAGE" FILE
FSAD:	DS	2	;START ADR. FOR "IMAGE" FILE
	DS	1	;SPARE
FDBK:	DS	1	;DIRECTORY BLOCK NUMBER
FDEN:	DS	1	;DIRECTORY ENTRY NUMBER
FAUX:	DS	2	;NEW FILE CLOSING SIZE, OR ...
			;... AUX. BYTE COUNT FOR SEQUENTIAL ROUTINES
FHAN:	DS	2	;HANDLER ADDRESS
FFCN:	DS	1	;HANDLER FUNCTION CODE
FDRV:	DS	1	;DRIVE NUMBER
FBLK:	DS	2	;BLOCK NO. FOR TRANSFER
FBUF:	DS	2	;BUFFER POINTER FOR TRANSFER
FXBC:	DS	2	;BYTE COUNT FOR TRANSFER
FPTR:	DS	2	;BBUF PNTR FOR SEQUENTIAL ROUTINES
FPBE:			;END OF SYSTEM FPB


DBF:			;DIR BLOCK BUFFER
DBLK:	DS	1	;"THIS" DIR BLOCK NUMBER
MDBLK:	DS	1	;MAX. DIR BLOCK NUMBER
	DS	126	;REMAINDER OF 128. BYTE DIR BLOCK BUFFER
DBFE:			;END OF DIR BLOCK BUFFER

; THE FOLLOWING 18. BYTES ARE THE DIR BLOCK BUFFER EXTENSION
; USED BY CLOSE WHEN THE "FREE" ENTRY MOVES TO THE NEXT BLOCK:

XFHAN:	DS	2	;AUX. HANDLER ADDRESS
XFFCN:	DS	1	;AUX. HANDLER FUNCTION CODE
XFDRV:	DS	1	;AUX. DRIVE NUMBER
XFBLK:	DS	2	;AUX. BLOCK NUMBER
XFBUF:	DS	2	;AUX. BUFFER POINTER
XFXBC:	DS	2	;AUX. BYTE COUNT
	DS	4	;*** USED BY COPY ***
TMP1:	DS	2	;USED BY COPY & MAYBE OTHERS ?
	DS	2
	ORG	$	;*** SHOULD NOT BE PAST "CRTRAM" ***


	ORG	FCSORG

CRTMO:	LXI	H,CRTMSG
	CALL	OSTR
	LHLD	ACRTSP
	SPHL
	LXI	H,BEGEX
	PUSH	H
	PCHL

CRTMSG:	DB	6,2,11,29,'COMPUCOLOR II ',17,'CRT ',22,'MODE V6.78'
	DB	18,10,11,239


FCS:	LXI	D,CMTAB	;POINT TO COMMAND TABLE
F1:	PUSH	H	;SAVE COMMAND LINE PNTR
	MVI	B,3	;SET COUNTER
F2:	LDAX	D	;GET NEXT COMMAND CHARACTER
	INX	D
	CMP	M	;MATCH ?
	INX	H
	JZ	F4	;YES
F3:	INX	D	;SKIP TO ...
	DCR	B	;... NEXT ...
	JP	F3	;... COMMAND
	POP	H	;GET COMMAND LINE PNTR
	LDAX	D	;GET BYTE
	ANA	A	;END OF COMMAND TABLE ?
	JNZ	F1	;NO: TRY NEXT COMMAND
IVC:	MVI	B,EIVC	;SET ERROR CODE
	RET		;ERROR EXIT: INVALID COMMAND
F4:	DCR	B	;ENOUGH ?
	JNZ	F2	;NO: CHECK NEXT CHARACTER
	XTHL
	LXI	H,FCSEX	;POINT TO EXIT ROUTINE
	XTHL
	XCHG
	MOV	C,M	;GET LOBYTE OF ROUTINE ADDRESS
	INX	H
	MOV	B,M	;GET HIBYTE OF ROUTINE ADDRESS
	PUSH	B	;PUT ROUTINE ADDRESS ON STACK
	LXI	H,FPB	;POINT TO FPB
	SHLD	FPBP	;SAVE POINTER
	XCHG
	CALL	LTNOR	;SKIP TRAILING LETTERS
	JMP	SPNOR	;SKIP SPACES & GO TO ROUTINE

FCSEX:	PUSH	B	;SAVE STATUS CODE
	CALL	RESET	;RESET DEVICES
	POP	B	;RESTORE STATUS CODE
	MOV	A,B	;GET STATUS CODE
	ANA	A	;TEST IT
	RET		;RETURN TO CALLER

FCSEM:	CALL	FCS	;PROCESS COMMAND LINE
EMESS:	MOV	A,B	;COPY STATUS CODE
	ANA	A	;TEST IT
	RZ		;NO ERRORS
	PUSH	PSW	;SAVE ERROR CODE & FLAGS
	LXI	H,FERS1
	CALL	OSTR	;PRINT MESSAGE
	LXI	H,FERS2-3
	MOV	C,B
	MVI	B,0
	DAD	B
	MVI	B,3
	CALL	PSTR	;PRINT ERROR CODE
	CALL	CRLF
	POP	PSW	;RESTORE ERROR CODE & FLAGS
	RET		;RETURN TO CALLER


; ERROR CODE DEFINITIONS :

FERS1:	DB 255,6,1,11,'FCS ERROR - E',239

FERS2:
	DB	'IVC'	;INVALID COMMAND
EIVC	EQU	$-FERS2
	DB	'MVN'	;MISSING VOLUME NAME
EMVN	EQU	$-FERS2
	DB	'SYN'	;SYNTAX ERROR
ESYN	EQU	$-FERS2
	DB	'DIR'	;DIRECTORY ERROR
EDIR	EQU	$-FERS2
	DB	'IVP'	;INVALID PARAMETER(S)
EIVP	EQU	$-FERS2
	DB	'NVE'	;NO VOLUME ENTRY IN DIRECTORY
ENVE	EQU	$-FERS2
	DB	'MFN'	;MISSING FILE NAME
EMFN	EQU	$-FERS2
	DB	'MDV'	;MISSING DEVICE NAME
EMDV	EQU	$-FERS2
	DB	'MVR'	;MISSING VERSION
EMVR	EQU	$-FERS2
	DB	'IVD'	;INVALID DEVICE
EIVD	EQU	$-FERS2
	DB	'NSA'	;NO START ADDRESS
ENSA	EQU	$-FERS2
	DB	'DFN'	;DUPLICATE FILE NAME
EDFN	EQU	$-FERS2
	DB	'VOV'	;VERSION NUMBER OVERFLOW
EVOV	EQU	$-FERS2
	DB	'FNF'	;FILE NOT FOUND
EFNF	EQU	$-FERS2
	DB	'DRF'	;DIRECTORY FULL
EDRF	EQU	$-FERS2
	DB	'FRD'	;FILE READ ERROR
EFRD	EQU	$-FERS2
	DB	'FWR'	;FILE WRITE ERROR
EFWR	EQU	$-FERS2
	DB	'WSZ'	;FILE TOO LARGE FOR WRITE
EWSZ	EQU	$-FERS2
	DB	'RSZ'	;FILE TOO LARGE FOR READ
ERSZ	EQU	$-FERS2
	DB	'DEL'	;DELETE ERROR
EDEL	EQU	$-FERS2
	DB	'DUP'	;ERROR DURING DUPLICATE
EDUP	EQU	$-FERS2
	DB	'SIZ'	;DEVICE SIZES NOT SAME
ESIZ	EQU	$-FERS2
	DB	'COP'	;ERROR DURING COPY
ECOP	EQU	$-FERS2
	DB	'IVT'	;INVALID FILE TYPE
EIVT	EQU	$-FERS2
	DB	'BLF'	;BAD '.LDA' FILE
EBLF	EQU	$-FERS2


RESET:	LXI	B,103H	;SET FLAG & COUNTER
	LXI	H,HDVCT	;POINT TO HANDLER VECTOR AREA
RS01:	MVI	A,0C3H	;SET 'JMP' BYTE
	CMP	M	;VECTOR EMPTY ?
	JNZ	RS02	;YES: SKIP IT
	PUSH	H	;SAVE HANDLER PNTR
	PUSH	B	;SAVE FLAG & COUNTER
	XCHG		;DE=HANDLER PNTR
	LXI	H,OFFPB	;POINT TO HANDLER PB
	CALL	JMPD	;CALL HANDLER
	POP	B	;RESTORE FLAG & COUNTER
	POP	H	;GET HANDLER PNTR
	PUSH	H	;SAVE HANDLER PNTR
	INX	H	;POINT TO DEVICE NAME ...
	INX	H
	INX	H
	MOV	E,M	;GET 1ST CHAR. OF NAME
	INX	H
	MOV	D,M	;GET 2ND CHAR. OF NAME
	LHLD	DFDV	;GET DEFAULT DEVICE NAME
	CALL	CMPDH	;MATCH ?
	POP	H	;RESTORE HANDLER PNTR
	JNZ	RS02	;NO MATCH: STEP TO NEXT
	INR	B	;INDICATE DEFAULT DEVICE SEEN
RS02:	LXI	D,10
	DAD	D	;STEP TO NEXT HANDLER
	DCR	C	;ANY MORE ?
	JNZ	RS01	;YES: LOOP
	DCR	B	;WAS DEFAULT DEVICE SEEN ?
	RNZ		;YES: EXIT
	LHLD	IDEV	;GET INITIAL DEFAULT DEVICE
	SHLD	DFDV	;SET DEFAULT DEVICE
	LDA	IUNT	;GET INITIAL UNIT NO.
	STA	DFUN	;STORE IT
	RET		;EXIT

OFFPB:	DB	-4,0	;"TURN OFF" FUNCTION


CKEND:	CALL	SPNOR	;SKIP SPACES
	RZ		;RETURN <Z> IF END OF LINE
ERSYN:	MVI	B,ESYN	;SET ERROR CODE
	RET		;RETURN <NZ> IF NOT END OF LINE


WRI00:	MVI	A,1	;SET WRITE CODE
	DB	0FEH	;*** SKIP 1 BYTE ***
REA00:	XRA	A	;SET READ CODE
	STA	FFCN	;SAVE FUNCTION CODE
	CALL	PDV	;GET DEVICE NAME
	RC		;ERROR
	CALL	GN2Z	;GET BLOCK NUMBER
	JNC	GM02	;NO NUMBER: ERROR
	XCHG
	SHLD	FBLK	;STORE BLOCK NUMBER
	XCHG
	CALL	GMPRM	;GET MEMORY PARAMS
	RC		;ERROR
	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;NO: ERROR
	XCHG
	SHLD	FBUF	;STORE BUFFER ADDRESS
	MOV	H,B
	MOV	L,C
	SHLD	FXBC	;STORE BYTE COUNT
	LDA	FFCN	;GET FUNCTION CODE
	LXI	H,FHAN
	CALL	CHDLR	;CALL HANDLER
GDRET:	MVI	B,0
	RET


; INITIALIZE VOLUME DIRECTORY :

INI00:	CALL	PDV	;PARSE DEVICE NAME
	RC		;ERROR: INVALID DEVICE
	RZ		;ERROR: MISSING DEVICE NAME
	CALL	SPNOR	;SKIP SPACES
	LXI	D,DBF+3	;POINT TO BUFFER
	MVI	B,10	;SET COUNTER
	CALL	MSTR	;MOVE VOLUME NAME
	MVI	B,EMVN	;SET ERROR CODE
	RZ		;ERROR: MISSING VOLUME NAME
	CALL	GCMA	;SKIP COMMA IF IT'S THERE
	CALL	GN2Z	;GET NUMBER IF IT'S THERE
	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;NO: ERROR
	PUSH	D	;SAVE USER'S NUMBER
	LXI	H,FHAN	;POINT TO HANDLER ADDRESS
	PUSH	H	;SAVE PNTR
	MVI	A,-2	;SET "ON" CODE
	CALL	CHDLR	;CALL HANDLER
	POP	H	;RESTORE PNTR
	MVI	A,-1	;SET "GET SIZE" CODE
	CALL	CHDLR	;CALL HANDLER
	POP	D	;RESTORE USER'S NUMBER
	MVI	B,EDIR	;SET ERROR CODE
	RC		;ERROR GETTING SIZE
	PUSH	H	;SAVE DEVICE SIZE
	MOV	A,E	;GET USER-SPECIFIED DIR. SIZE
	ANA	A	;IS IT ZERO ?
	JNZ	INI01	;NO: USE IT
	DAD	H
	MOV	A,H	;TOTAL BLKS./128.
	JC	INI02	;OVERFLOW: USE MAX.
	CPI	1	;ENSURE AT LEAST ONE ...
	ACI	0
INI01:	CPI	DSBUFS/128 + 1	;VALID ?
	JC	INI03		;YES: USE IT
INI02:	MVI	A,DSBUFS/128	;SET MAX. NO. OF DIR. BLOCKS
INI03:	MOV	E,A
	MVI	D,0	;DE=STRT BLK OF FREE SPACE
	LXI	H,0
	SHLD	FBLK	;SET BLOCK NUMBER
	LXI	H,DBF	;POINT TO BUFFER
	SHLD	FBUF	;SET BUFFER PNTR
	MOV	M,D	;SET DIR. BLK. NO. ZERO
	INX	H
	DCR	A
	MOV	M,A	;SET MAX. DIR. BLK. NO.
	INX	H
	MVI	M,41H	;SET "VOLUME" ATTRIBUTE BYTE
	POP	H	;GET DEVICE SIZE
	CALL	SUBHD	;COMPUTE NO. OF FREE BLOCKS
	MOV	B,H
	MOV	C,L
	LXI	H,DBF+2+21
	CALL	SFR	;SETUP FREE ENTRY
	CALL	WRDIR	;WRITE DIRECTORY BLOCK
	RC		;ERROR
	JMP	DIR01	;GO LIST DIRECTORY

; LIST DIRECTORY :
DIR00:	CALL	PDV	;GET DEVICE NAME
	RC		;ERROR: INVALID DEVICE
	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;NO: ERROR
DIR01:	LXI	D,FPB	;POINT TO FPB
	LXI	H,MS1	;POINT TO DIR. HEADER MSG.
	CALL	OSTR	;PRINT IT
	CALL	PRDEV	;PRINT DEVICE NAME
	LXI	D,FHAN	;POINT TO FHAN
	CALL	OPDIR	;'OPEN' DIRECTORY
	RC		;ERROR
	PUSH	B	;SAVE ...
	PUSH	D	;... THINGS ...
	PUSH	H	;...
	INX	H	;SKIP TYPE CODE
	MVI	B,10	;SET COUNT
	CALL	PSSTR	;PRINT VOLUME LABEL
	CALL	PSPAC	;PRINT A SPACE
	LDA	DBF+1	;GET MAX. DIR. BLK NO.
	INR	A	;CHANGE TO NO. OF BLOCKS
	CALL	LBYT	;PRINT IT
	LXI	H,MS2	;POINT TO HEADING
	CALL	OSTR	;PRINT HEADING
DIR02:	POP	H	;RESTORE ...
	POP	D	;... THINGS ...
	POP	B	;...
	CALL	CRLF	;PRINT CR&LF
	CALL	RTST	;GOT A KEY ?
	JNZ	DIR05	;NO: PROCEED 
	CPI	10	;IS IT LF ?
	CZ	LO	;ECHO LF 
	JZ	GDRET	;YES: STOP 
DIR05:	CALL	GNDE	;GET NEXT DIRECTORY ENTRY
	RC		;ERROR
	JZ	DIR04	;FINISHED
	PUSH	B	;SAVE ...
	PUSH	D	;... THINGS ...
	PUSH	H	;...
	MOV	B,M	;GET TYPE CODE
	CALL	PSBYT	;PRINT TYPE CODE
	MVI	A,TFREE	;GET 'FREE' TYPE CODE
	CMP	B	;IS THIS THE 'FREE' ENTRY ?
	JZ	DIR03	;YES
	MVI	B,6	;SET COUNTER
	CALL	PSSTR	;PRINT NAME
	MVI	A,'.'	;PRINT A ...
	CALL	LO	;... PERIOD
	MVI	B,3	;SET COUNTER
	CALL	PSTR	;PRINT TYPE
	MVI	A,';'	;PRINT A ...
	CALL	LO	;... SEMICOLON
	CALL	PBYT	;PRINT VERSION NUMBER
	CALL	PSNUM	;PRINT STARTING BLOCK NUMBER
	CALL	PSNUM	;PRINT SIZE
	CALL	PSBYT	;PRINT LAST BLK BYTE COUNT
	CALL	P2SNUM	;PRINT LOAD ADDRESS
	CALL	PSNUM	;PRINT START ADDRESS
	JMP	DIR02	;STEP TO NEXT ENTRY
DIR03:	XCHG
	LXI	H,MS3	;POINT TO STRING
	CALL	OSTR	;PRINT IT
	LXI	H,FSBK-FNAM
	DAD	D	;POINT TO FSBK
	CALL	PSNUM	;PRINT STARTING BLOCK NUMBER
	CALL	PSNUM	;PRINT SIZE
	CALL	CRLF
DIR04:	POP	H	;CLEAN ...
	POP	H	;... THE ...
	POP	H	;... STACK
	CALL	CRLF
	MVI	B,0	;SET O.K. CODE
	RET		;THAT'S ALL

; SAVE "IMAGE" TYPE FILE :
SAV00:	CALL	PPFSP	;GET FILE SPECIFICATION
	RC		;ERROR
	CALL	GMPRM	;GET MEMORY PARAMS
	RC		;ERROR
	XCHG
	SHLD	FLAD	;STORE LOAD ADDRESS
	XCHG
	CALL	GN1D	;GET START ADDRESS
	XCHG
	SHLD	FSAD	;STORE START ADDRESS
	XCHG
	CALL	GN1Z	;GET AUX. MEM. ADDRESS
	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;NO: ERROR
WF2:	MVI	A,FNEW	;SET OPEN TYPE CODE
	CALL	OPENX	;OPEN THE FILE
	RC		;ERROR
	CALL	WRITE	;WRITE THE FILE
	RC		;ERROR
CLX:	CALL	CLOSE	;CLOSE THE FILE
	RC		;ERROR
	LXI	D,FHAN-FPB
	DAD	D	;POINT TO FHAN
	MVI	A,-3	;SET "SUB USER" FUNCTION
	CALL	CHDLR	;CALL THE HANDLER
	XRA	A	;CLEAR C-FLAG
	MOV	B,A	;SET GOOD STATUS
	RET		;EXIT

; LOAD A FILE :
LOA00:	LXI	B,LTYP	;SET DEFAULT TYPE
	CALL	PFSPC	;GET FILE SPECIFICATION
	RC		;ERROR 
	CALL	QLDA	;IS IT '.LDA' ?
	JZ	LOLDA	;YES 
; LOAD AN "IMAGE" FILE :
	CALL	GCMA	;SKIP COMMA IF IT'S THERE
	CALL	GN2Z	;GET AUX. LOAD ADDRESS
	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;NO: ERROR
RF1:	LXI	B,0FFFFH ;SET MAX. BYTE COUNT
RF2:	XRA	A	;SET OPEN TYPE CODE
	CALL	OPENX	;OPEN THE FILE
	RC		;ERROR
	CALL	READ	;READ THE FILE
	RC		;ERROR
	JMP	CLX	;CLOSE FILE & EXIT

; LOAD A '.LDA' FILE :
LOLDA:	CALL	SULD	;SETUP FOR '.LDA' LOAD
	CALL	CKEND	;END OF LINE ?
	JZ	LLDA	;YES: LOAD ALL AT CORRECT ADDRESS 
	CALL	GCMA	;SKIP COMMA IF THERE
	CALL	GN2Z	;GET 'LOWEST ADDRESS TO LOAD'
	JNC	ERSYN	;SYNTAX ERROR 
	XCHG
	SHLD	XFHAN	;SAVE 'LOWEST ADDRESS TO LOAD'
	LXI	H,0A000H
	SHLD	XFFCN	;SET DEFAULT 'LOWEST MEMORY ADDRESS'
	XCHG
	CALL	CKEND	;END OF LINE ?
	JZ	LLDA	;YES: USE DEFAULT MEMORY SPECS 
	CALL	GMPRM	;GET MEMORY PARAMS
	RC		;ERROR 
	CALL	CKEND	;END OF LINE ?
	RNZ		;NO: ERROR 
	MOV	A,B	;TEST BYTE COUNT ...
	ORA	C
	JZ	LOL1	;ZERO: USE DEFAULT 'HIGHEST' 
	MOV	H,B	;COPY BYTE COUNT ...
	MOV	L,C
	DCX	H	;ADJUST IT
	DAD	D	;COMPUTE END ADDRESS
	MVI	B,EIVP
	RC		;ERROR 
	SHLD	XFBLK	;SAVE 'HIGHEST MEMORY ADDRESS'
LOL1:	XCHG
	SHLD	XFFCN	;SAVE 'LOWEST MEMORY ADDRESS'

LLDA:	LHLD	XFHAN	;GET 'LOWEST ADDRESS TO LOAD'
	XCHG
	LHLD	XFFCN	;GET 'LOWEST MEMORY ADDRESS'
	CALL	SUBHD	;COMPUTE OFFSET
	SHLD	XFHAN	;SAVE OFFSET
	XRA	A	;SET OPEN TYPE
	CALL	OPENX	;OPEN THE FILE
	RC		;ERROR 
	CALL	RWSEQI	;INITIALIZE FOR SEQUENTIAL INPUT
	XCHG
	LXI	H,0	;INITIAL START ADDRESS
LOL3:	SHLD	FSAD	;STORE START ADDRESS
	XCHG
LOL4:	CALL	GTBYT	;GET A BYTE
	JC	EOFOK	;ERROR OR EOF 
	MOV	C,A	;LOBYTE OF BYTE COUNT
	CALL	GTBYT
	JC	LER1	;ERROR 
	MOV	B,A	;HIBYTE OF BYTE COUNT
	ORA	C	;IS IT ZERO ?
	JZ	LOL4	;YES: EMPTY RECORD 
	DCX	B
	MOV	A,B
	ORA	C	;WAS IT ONE ?
	JZ	LER2	;YES: FILE FORMAT ERROR 
	CALL	GTBYT
	JC	LER1	;ERROR 
	MOV	E,A	;LOBYTE OF LOAD ADDRESS
	CALL	GTBYT
	JC	LER1	;ERROR 
	MOV	D,A	;HIGH BYTE OF LOAD ADDRESS
	DCX	B
	MOV	A,B
	ORA	C	;ANY MORE ?
	XCHG
	JZ	LOL3	;NO: STORE START ADDRESS & LOOK FOR MORE 
	XCHG
	PUSH	H	;SAVE FPB PTR
	LHLD	XFHAN	;GET OFFSET
	DAD	D	;COMPUTE ACTUAL LOAD ADDRESS
	XCHG
	POP	H	;RESTORE FPB PTR
LOL5:	CALL	GTBYT	;GET NEXT DATA BYTE
	JC	LER1	;ERROR 
	PUSH	H	;SAVE FPB PTR
	PUSH	PSW	;SAVE THE BYTE
	LHLD	XFFCN	;GET LOW LIMIT
	CALL	CMPDH	;LOAD IT ?
	JC	LOL6	;NO 
	LHLD	XFBLK	;GET HIGH LIMIT
	CALL	CMPHD	;LOAD IT ?
LOL6:	POP	H	;GET BYTE BACK ...
	MOV	A,H	;... INTO A
	POP	H	;RESTORE FPB PTR
	JC	LOL7	;DON'T LOAD THIS BYTE 
	STAX	D	;LOAD THE BYTE INTO MEMORY
LOL7:	INX	D	;INCREMENT LOAD ADDRESS
	DCX	B	;COUNT THE BYTE
	MOV	A,B
	ORA	C	;ANY MORE ?
	JNZ	LOL5	;YES: LOOP 
	JMP	LOL4	;NO: LOOK FOR NEXT RECORD 
EOFOK:	CMC		;CLEAR <C> STATUS BIT
	PUSH	PSW	;SAVE STATUS
	CALL	CLX	;CLOSE & TURN MOTOR OFF
	POP	PSW	;RESTORE STATUS
	RZ		;END OF FILE: O.K. 
LER1:	MVI	B,EFRD
	STC		;INDICATE ERROR
	RNZ		;READ ERROR 
LER2:	MVI	B,EBLF
	STC
	RET		;FORMAT ERROR 


; RUN A PROGRAM :
RUN00:	CALL	PPFSP	;GET FILE SPECIFICATION
	RC		;ERROR
	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;NO: ERROR
	CALL	QLDA	;IS IT '.LDA' ?
	JNZ	RUN01	;NO 
	CALL	SULD	;SETUP FOR '.LDA' LOAD
	CALL	LLDA	;LOAD THE FILE
	JMP	RUN02
RUN01:	LXI	B,PTYP
	CALL	QTYP	;IS IT '.PRG' ?
	MVI	B,EIVT
	RNZ		;NO: INVALID TYPE 
; RUN AN "IMAGE" ( TYPE '.PRG' ) PROGRAM :
	LXI	D,0	;SET AUX. LOAD ADDRESS
	CALL	RF1	;READ THE FILE
RUN02:	RC		;ERROR
	LHLD	FSAD	;GET START ADDRESS
	MOV	A,H
	ORA	L
	MVI	B,ENSA	;SET ERROR CODE
	RZ		;NO START ADDRESS
	PCHL		;GO TO THE PROGRAM

SULD:	PUSH	H
	LXI	H,0
	SHLD	XFHAN	;SET 'LOWEST ADDRESS TO LOAD'
	SHLD	XFFCN	;SET 'LOWEST MEMORY ADDRESS'
	DCX	H
	SHLD	XFBLK	;SET 'HIGHEST MEMORY ADDRESS'
	POP	H
	RET


DEV00:	CALL	PDV	;PARSE DEVICE NAME
	RC		;ERROR
	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;NO: ERROR
	LXI	H,MS4
	CALL	OSTR
	CALL	PRDEV	;PRINT DEVICE NAME
	CALL	CRLF
	LXI	H,DFDV	;POINT TO DEFAULT DEVICE AREA
	MOV	M,E	;STORE ...
	INX	H	;... DEVICE ...
	MOV	M,D	;... NAME
	INX	H
	MOV	M,C	;STORE UNIT NUMBER
	MVI	B,0	;INDICATE NO ERRORS
	RET		;EXIT

DEL00:	LXI	B,NTYP	;SET DEFAULT TYPE
	CALL	PFSPC	;GET FILE SPECIFICATION
	RC		;ERROR
	RZ		;NO VERSION: ERROR
	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;NO: ERROR
	XRA	A	;SET OPEN TYPE CODE
	CALL	OPENX	;OPEN THE FILE
	RC		;ERROR
	LHLD	FDBK	;GET DIR. BLK. NUMBER ...
	MVI	H,0	;...
	SHLD	FBLK	;STORE BLOCK NUMBER
	LXI	H,DBF+2	;SETUP TO ...
	LXI	D,FHAN	;... CONTINUE DIR ...
	MVI	B,6	;... SCAN
DEL01:	CALL	GNDE	;GET NEXT DIRECTORY ENTRY
	RC		;ERROR
	CPI	TFREE	;IS THIS THE 'FREE' ENTRY ?
	JNZ	DEL01	;NO: KEEP LOOKING FOR IT
	LXI	D,FSBK-FATR ;POINT TO FSBK ...
	DAD	D	;... IN DIR ENTRY
	MOV	E,M	;GET STARTING BLOCK ...
	INX	H	;... NUMBER OF ...
	MOV	D,M	;... THE 'FREE'
	PUSH	D	;SAVE START BLOCK OF FREE
	CALL	CPYDV	;COPY DEVICE INFO
	LHLD	FSBK	;GET START BLK OF FILE
	SHLD	FBLK	;SET DESTINATION START BLK
	XCHG
	LHLD	FSIZ	;GET FILE SIZE
	DAD	D	;COMPUTE SOURCE START BLOCK
	SHLD	XFBLK	;SET SOURCE START BLOCK
	XCHG		;D&E = SOURCE START BLOCK
	POP	H	;GET START BLOCK OF FREE
	CALL	SUBHD	;COMPUTE NO. OF BLKS TO MOVE
	XCHG		;PUT RESULT IN D&E
	CALL	MCHNK	;MOVE THE DATA
	JC	DELER	;ERROR DURING MOVE
	LHLD	FDBK	;GET DIR. BLK. NUMBER ...
	MVI	H,0	;...
	SHLD	FBLK	;SET BLOCK NO. FOR XFER
	XCHG
	LDA	MDBLK	;GET MAX. DIR BLK NO.
	INR	A	;NO. OF DIR BLOCKS
	MOV	L,A
	MOV	H,D
	CALL	SUBHD	;COMPUTE BLOCKS TO XFER
	MVI	C,80H
	CALL	BK2BC	;CHANGE TO BYTE COUNT
	SHLD	FXBC	;STORE BYTE COUNT
	LXI	H,FHAN	;POINT TO FHAN
	CALL	RD	;READ THE DIRECTORY
	JC	DELER	;DIR. READ ERROR
	LXI	H,DSBUF+2+6*21 ;PNT PAST 1ST BLOCK
	CALL	CENTR	;COMPUTE ENTRY PNTR
DEL06:	PUSH	H	;SAVE PNTR TO DESTINATION SLOT
	LXI	D,21
	DAD	D	;POINT TO SOURCE SLOT
	XCHG
	POP	H	;RESTORE DEST. SLOT PNTR
	PUSH	H	;RESAVE IT
	MOV	A,B	;GET SLOT NUMBER
	DCR	A	;IS DEST. SLOT LAST SLOT IN BLK ?
	JNZ	DEL07	;NO: O.K.
	INX	D	;ADJUST SOURCE ...
	INX	D	;... SLOT POINTER
DEL07:	PUSH	B	;SAVE B&C
	MVI	B,21	;SET COUNT
	CALL	MOVHD	;MOVE THE ENTRY
	POP	B	;RESTORE B&C
	POP	H	;GET DEST. SLOT PNTR
DEL08:	PUSH	H	;SAVE DEST. SLOT POINTER
	LXI	D,FSBK-FATR
	DAD	D	;POINT TO FSBK IN SLOT
	MOV	E,M	;GET STARTING ...
	INX	H	;... BLOCK ...
	MOV	D,M	;... NUMBER
	PUSH	H	;SAVE POINTER
	LHLD	FSIZ	;GET SIZE OF DELETED FILE
	XCHG
	CALL	SUBHD	;COMPUTE NEW STARTING BLK NO.
	XCHG
	POP	H	;RESTORE POINTER
	MOV	M,D	;STORE ADJUSTED ...
	DCX	H	;... STARTING ...
	MOV	M,E	;... BLOCK NUMBER
	POP	H	;GET DEST. SLOT PNTR
	MOV	A,M	;GET TYPE CODE
	CPI	TFREE	;IS THIS THE 'FREE' ?
	JZ	DEL09	;YES
	LXI	D,21
	DAD	D	;STEP TO NEXT SLOT
	DCR	B	;WAS THIS LAST SLOT IN BLOCK ?
	JNZ	DEL06	;NO: GO DO NEXT SLOT
	INX	H	;ADJUST ...
	INX	H	;... SLOT POINTER
	MVI	B,6	;RESET SLOT COUNTER
	JMP	DEL06	;GO DO NEXT SLOT
DEL09:	LXI	D,FSIZ-FATR
	DAD	D	;POINT TO SIZE OF 'FREE'
	MOV	E,M	;GET SIZE ...
	INX	H	;... OF ...
	MOV	D,M	;... 'FREE'
	PUSH	H	;SAVE POINTER
	LHLD	FSIZ	;GET SIZE OF DELETED FILE
	DAD	D	;COMPUTE NEW 'FREE' BLOCKS
	XCHG
	POP	H	;RESTORE POINTER
	MOV	M,D	;STORE NEW ...
	DCX	H	;... SIZE OF ...
	MOV	M,E	;... 'FREE'
	LXI	D,FDBK-FSIZ
	DAD	D	;POINT TO NEXT SLOT
	DCR	B	;WAS THIS LAST SLOT ?
	JNZ	DEL10	;NO: O.K.
	INX	H	;ADJUST ...
	INX	H	;... SLOT POINTER
DEL10:	MVI	M,0	;MARK END OF DIRECTORY
	LXI	H,FHAN	;POINT TO FHAN
	CALL	WR	;WRITE DIRECTORY
	JC	DELER	;ERROR
	CALL	ERAS	;ERASE PAGE
	JMP	DIR01	;GO LIST DIRECTORY
DELER:	MVI	B,EDEL	;SET ERROR CODE
	RET

CENTR:	LXI	D,-21
	LDA	FDEN	;GET ENTRY NO. OF FILE
	MOV	B,A	;COPY IT
CEN01:	DAD	D	;BACK UP ONE ENTRY
	DCR	A	;ENOUGH ?
	JNZ	CEN01	;NO: DO IT AGAIN
	RET		;RETURN


QLDA:	LXI	B,LTYP
QTYP:	PUSH	H	;SAVE H
	LXI	H,FTYP
	MVI	E,3	;SET COUNTER
CMT1:	LDAX	B	;GET BYTE
	INX	B
	CMP	M	;COMPARE
	INX	H
	JNZ	CMT2	;DOES NOT MATCH 
	DCR	E	;CHECKED ALL THREE ?
	JNZ	CMT1	;NO: CHECK NEXT 
CMT2:	POP	H	;RESTORE H
	RET		;<Z>: MATCH, <NZ>: NO MATCH 


REN00:	SHLD	XFBLK	;SAVE STRING PNTR
	CALL	PNFSP	;GET OLD NAME
	RC		;ERROR
	CALL	GETTO	;GET "TO"
	RNZ		;ERROR
	CALL	CPYDV	;COPY DEVICE INFO
	CALL	PCFSP	;GET NEW NAME
	RC		;ERROR
	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;NO: ERROR
	LHLD	XFHAN	;FORCE ...
	SHLD	FHAN	;... SAME ...
	LDA	XFDRV	;... DEVICE ...
	STA	FDRV	;...
	CALL	OPOX	;OPEN THE FILE
	RC		;ERROR
	LXI	D,FNAM	;POINT TO NEW NAME
	LXI	H,XFBUF	;POINT TO TEMP AREA
	MVI	B,10	;SET COUNT
	CALL	MOVHD	;COPY NEW NAME
	LHLD	XFBLK	;GET STRNG PNTR TO OLD NAME
	LXI	D,FPB	;POINT TO FPB
	CALL	PNFSP	;GET OLD NAME AGAIN
	XRA	A	;SET OPEN TYPE CODE
	CALL	OPENX	;OPEN OLD FILE
	RC		;ERROR
	CALL	GODBK	;GET DIR BLK
	RC		;ERROR
	LXI	H,DBF+2+6*21+1
	CALL	CENTR	;COMPUTE ENTRY PNTR
	LXI	D,XFBUF	;POINT TO TEMP AREA
	MVI	B,10	;SET COUNT
	CALL	MOVHD	;MOVE IN NEW NAME
	LHLD	FDBK	;GET DIR BLK NO.
	MVI	H,0
	SHLD	FBLK	;SET BLOCK NUMBER
	LXI	H,DBFE	;SET END PNTR
	JMP	WRDIR	;GO WRITE DIR BLK 


COP00:	SHLD	XFBLK	;SAVE STRING PNTR
	CALL	PNFSP	;GET SOURCE NAME
	RC		;ERROR
	CALL	GETTO	;GET "TO"
	RNZ		;ERROR
	SHLD	TMP1	;SAVE STRING PNTR
	CALL	PCFSP	;GET DESTINATION NAME
	JNC	COP01	;O.K.
	MVI	A,EMFN
	CMP	B	;MISSING FILE NAME ?
	RNZ		;NO: ERROR
COP01:	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;NO: ERROR
	LHLD	XFBLK	;GET SOURCE PNTR
	CALL	PNFSP	;GET SOURCE NAME
	CALL	CPYDV	;COPY DEVICE INFO
	XRA	A	;SET OPEN TYPE CODE
	CALL	OPENX	;OPEN SOURCE FILE
	RC		;ERROR
	LXI	D,FSBK	;SET SOURCE PNTR
	LXI	H,XFBLK	;SET DESTINATION PNTR
	MVI	B,FDBK-FSBK ;SET COUNT
	CALL	MOVHD	;COPY FILE INFO
	LXI	D,FPB	;POINT TO FPB
	LHLD	TMP1	;GET STRING PNTR
	CALL	PCFSP	;GET DESTINATION NAME
	MVI	A,FNEW	;SET OPEN TYPE CODE
	CALL	OPENX	;OPEN DESTINATION FILE
	RC		;ERROR
	LHLD	XFBLK+FSIZ-FSBK ;GET SOURCE FILE SIZE
	SHLD	FAUX	;SET SIZE FOR CLOSE
	XCHG
	LHLD	FSIZ	;GET "FREE" SIZE
	CALL	CMPHD	;SEE IF IT'LL FIT
	MVI	B,EWSZ	;SET ERROR CODE
	RC		;TOO BIG: ERROR
	PUSH	D	;SAVE FILE SIZE
	LXI	D,XFBLK+FLBC-FSBK ;SET SOURCE PNTR
	LXI	H,FLBC	;SET DESTINATION PNTR
	MVI	B,FDBK-FLBC ;SET COUNT
	CALL	MOVHD	;COPY FILE INFO BACK
	POP	D	;GET FILE SIZE BACK
	CALL	MCHNK	;COPY THE FILE
	MVI	B,ECOP	;SET ERROR CODE
	RC		;ERROR
	LXI	H,FPB	;POINT TO FPB
	JMP	CLX	;GO CLOSE FILE & EXIT

ERAS:	CALL	SAVE	;SAVE REGISTERS
	JMP	ERASE	;ERASE SCREEN AND RETURN

DUP00:	CALL	PDV	;GET DEVICE NAME
	RC		;ERROR:  INVALID DEVICE
	RZ		;ERROR:  NO DEVICE NAME
	CALL	GETTO	;GET 'TO'
	RNZ		;ERROR:
	LXI	D,XFHAN+FPB-FHAN
	CALL	PDV	;GET DESTINATION DEVICE NAME
	RC		;ERROR:  INVALID DEVICE
	RZ		;ERROR:  NO DEVICE NAME
	CALL	CKEND	;CHECK FOR END OF LINE
	RNZ		;ERROR:  NOT END OF LINE

	LXI	H,FHAN	;POINT TO FHAN
	MVI	A,-1	;SET 'GET SIZE' CODE
	CALL	CHDLR	;CALL HANDLER
	MVI	B,EDUP
	RC		;ERROR: DUPLICATE ERROR

	PUSH	H	;SAVE SOURCE DEVICE SIZE
	LXI	H,XFHAN	;POINT TO XFHAN
	MVI	A,-1
	CALL	CHDLR	;GET SIZE
	POP	D	;RESTORE SURCE SIZE
	MVI	B,EDUP
	RC		;ERROR: DUPLICATE ERROR

	CALL	CMPHD	;ARE THE SIZES THE SAME?
	MVI	B,ESIZ
	RNZ		;ERROR:  NOT SAME SIZE

	SHLD	TMP1	;SAVE SIZE

	XRA	A
	STA	FNAM	;SET INVALID NAME
	CALL	OPOX	;OPEN FILE
	JC	DUP02	;ERROR: DUPLICATE ALL

	LHLD	FSBK	;GET START BLK NO. OF 'FREE'
	SHLD	TMP1	;SAVE AS NUMBER OF BLOCKS TO DUPLICATE

DUP02:	LHLD	XFHAN	;SWITCH DEVICES
	LDA	XFDRV
	MOV	B,A
	CALL	CPYDV
	SHLD	FHAN
	MOV	A,B
	STA	FDRV

	LHLD	TMP1	;GET NO. OF BLKS TO DUPLICATE
	XCHG
	LXI	H,0
	SHLD	XFBLK	;SET STARTING BLOCK NUMBERS
	SHLD	FBLK
	CALL	MCHNK	;MOVE THE DATA
	MVI	B,EDUP
	RC		;ERROR:
	MVI	B,0
	RET		;EXIT

OPOX:	MVI	A,FNEW	;SET OPEN TYPE CODE
	CALL	OPENX	;OPEN THE FILE
	RNC		;NO ERRORS: RETURN
	MVI	A,EDRF	;IS IT ...
	XRA 	B	;... DIRECTORY FULL ?
	RZ		;YES: O.K. RETURN
	STC		;INDICATE ERROR
	RET		;RETURN


GETTO:	MVI	B,ESYN	;SET ERROR CODE
	CALL	SPNOR	;GET 1ST NON-SPACE
	CPI	'T'	;IS IT 'T' ?
	RNZ		;NO: ERROR
	INX	H
	MOV	A,M	;GET NEXT CHARACTER
	INX	H
	CPI	'O'	;IS IT 'O' ?
	RET		;RETURN


MCHNK:	LXI	H,DSBUF	;POINT TO DISPLAY BUFFER
	SHLD	XFBUF	;SET BUFFER ...
	SHLD	FBUF	;... POINTERS
	PUSH	D	;SAVE NO. OF BLOCKS
	MVI	A,-2	;SET "ADD USER" CODE
	CALL	CTWO	;CALL HANDLERS
	POP	D	;GET NO. OF BLOCKS
MCH01:	CALL	ERAS	;ERASE PAGE
	MOV	A,E	;ANY ...
	ORA	D	;... LEFT ?
	JZ	STWO	;NO: FINISHED
	XCHG
	LXI	D,DSBUFS/128	;SET BUFFER SIZE
	CALL	SUBHD	;SUB. FROM NO. LEFT
	XCHG
	JNC	MCH02	;DO FULL BUFFER
	DAD	D	;ADJUST COUNT TO ORIG.
	LXI	D,0	;SET NONE LEFT
MCH02:	MVI	C,80H	;SET LAST BLK B.C.
	CALL	BK2BC	;CONVERT TO BYTE COUNT
	SHLD	XFXBC	;SET BYTE ...
	SHLD	FXBC	;... COUNTS
	PUSH	D	;SAVE REMAINING BLK COUNT
	LXI	H,XFHAN	;POINT TO SOURCE HPB
	CALL	RD	;READ
	POP	D	;RESTORE REMAINING BLK COUNT
	RC		;ERROR
	SHLD	XFBLK	;UPDATE THE BLOCK NUMBER
	PUSH	D	;SAVE REMAINING BLK COUNT
	LXI	H,FHAN	;POINT TO DESTINATION HPB
	CALL	WR	;WRITE
	POP	D	;RESTORE REMAINING BLK COUNT
	RC		;ERROR
	SHLD	FBLK	;UPDATE THE BLOCK NUMBER
	JMP	MCH01	;LOOP

STWO:	MVI	A,-3	;SET "SUB USER" FUNCTION
CTWO:	PUSH	PSW	;SAVE FCN CODE
	LXI	H,XFHAN	;POINT TO SOURCE HPB
	CALL	CHDLR	;CALL HANDLER
	POP	PSW	;RESTORE FCN CODE
	LXI	H,FHAN	;POINT TO DESTINATION HPB
	JMP	CHDLR	;CALL HANDLER & RETURN

CPYDV:	PUSH	H	;SAVE H&L
	LHLD	FHAN	;GET HANDLER ADDRESS
	SHLD	XFHAN	;SAVE IN AUX. HPB
	POP	H	;RESTORE H&L
	LDA	FDRV	;GET DRIVE NO.
	STA	XFDRV	;SAVE IN AUX. HPB
	RET		;RETURN


OPENX:	LXI	H,FPB	;POINT TO FPB
OPENY:	PUSH	B
	PUSH	D
	PUSH	PSW	;SAVE OPEN TYPE CODE
	PUSH	H
	LXI	D,FHAN-FPB
	DAD	D	;POINT TO FHAN
	MVI	A,-2	;SET "ADD USER" FUNCTION
	CALL	CHDLR
	POP	H	;RESTORE FPB PNTR
	POP	PSW	;RESTORE OPEN TYPE CODE
	MOV	M,A	;STORE OPEN TYPE CODE
	CALL	OPEN	;OPEN THE FILE
	POP	D
	JNC	OPX01
	POP	D
	RET
OPX01:	POP	B
	RET		;RETURN

GMPRM:	CALL	GCMA	;SKIP COMMA IF ANY
	CALL	GN2Z	;GET ONE NUMBER
	JNC	GM02	;NO NUMBER: ERROR
	PUSH	D	;SAVE 1ST NUMBER
	CALL	SPNOR	;SKIP SPACES
	SUI	'-'	;CHECK FOR '-'
	ANA	A	;CLEAR C-FLAG
	PUSH	PSW	;SAVE FLAGS
	INX	H
	JZ	GM03
	DCX	H
	CALL	GCMA	;SKIP COMMA IF NOT '-'
GM03:	CALL	GN2Z	;GET 2ND NUMBER
	CALL	GCMA	;SKIP COMMA IF THERE
	POP	PSW	;RESTORE FLAGS
	XTHL
	XCHG
	JNZ	GM01	;WAS NOT '-'
	CALL	SUBHD	;COMPUTE BYTE COUNT
	INX	H
GM01:	XTHL
	POP	B
	RNC		;O.K.: EXIT
GM02:	MVI	B,EIVP	;SET ERROR CODE
	STC		;INDICATE ERROR
	RET		;RETURN

PRDEV:	LXI	H,FHAN-FPB
	DAD	D	;POINT TO FHAN
	MOV	E,M	;GET LOBYTE OF HANDLER PNTR
	INX	H
	MOV	D,M	;GET HIBYTE OF HANDLER PNTR
	INX	H
	INX	H
	MOV	A,M	;GET UNIT NUMBER
	ADI	'0'	;CONVERT TO ASCII
	MOV	C,A	;COPY UNIT NO. TO C
	XCHG
	INX	H	;POINT TO DEVICE NAME
	INX	H
	INX	H
	MOV	E,M	;GET 1ST CHARACTER
	INX	H
	MOV	D,M	;GET 2ND CHARACTER
	MOV	A,E	;PRINT ...
	CALL	LO	;... 1ST CHAR.
	MOV	A,D	;PRINT ...
	CALL	LO	;... 2ND CHAR.
	MOV	A,C	;PRINT ...
	CALL	LO	;... UNIT NUMBER
	JMP	PCOLN	;PRINT ':' AND RETURN


MS1:	DB 10,10,'DIRECTORY ',239
MS2:	DB 13,10,10
	DB 'ATR  NAME TYPE VR SBLK SIZE LBC'
	DB ' LADR SADR',13,10,239
MS3:	DB ' <FREE SPACE> ',239
MS4:	DB 6,3,'DEFAULT DEVICE='
NTYP:	DB ' ',6,2,239

PTYP:	DB	'PRG'
LTYP:	DB	'LDA'
STYP:	DB	'SRC'





; DIRECTORY ACCESS ROUTINES :


;+
; OPDIR - "OPEN" DIRECTORY FOR A SCAN.
;
; INPUTS  - D&E: PNTR TO FHAN IN FPB
; OUTPUTS - <C>  : DIRECTORY READ ERROR,
;		   OR NO VOLUME ENTRY
;	    <NC> : NO ERRORS AND :
;	    A    : ATR BYTE OF THIS ENTRY (=41H)
;	    B    : INTERNALLY MAINTAINED ENTRY COUNTER
;	    D&E  : PNTR TO FHAN IN FPB (UNCHANGED)
;	    H&L  : PNTR TO "VOLUME" ENTRY IN DIRECTORY
;-

OPDIR:	LXI	H,FBLK-FHAN
	DAD	D	;POINT TO FBLK
	PUSH	D	;SAVE PNTR TO FHAN
	LXI	D,DIP	;POINT TO INITIAL PARAMETERS
	MVI	B,DIPS	;SET BYTE COUNT
	CALL	MOVHD	;MOVE PARAMETERS
	POP	H	;GET FHAN PNTR
	PUSH	H	;RESAVE IT
	MVI	A,-2	;SET "ADD USER" FUNCTION
	CALL	CHDLR	;CALL HANDLER
	POP	D	;RESTORE PNTR TO FHAN
	CALL	L001	;GO READ 1ST DIRECTORY BLOCK
	RC		;ERROR
	CPI	41H	;IS THIS VOLUME ENTRY ?
	RZ		;YES: O.K.: EXIT
	MVI	B,ENVE	;SET ERROR CODE
	STC
	RET		;ERROR EXIT

DIP:	DW	0	;BLOCK NUMBER
	DW	DBF	;BUFFER POINTER
	DW	128	;BYTE COUNT
DIPS	EQU	$-DIP

;+
; GNDE  - GET NEXT DIRECTORY ENTRY
;
; INPUTS  - B    : INTERNALLY MAINTAINED ENTRY COUNTER
;	    D&E  : PNTR TO FHAN IN FPB
;	    H&L  : PNTR TO CURRENT DIRECTORY ENTRY
; OUTPUTS - <C>  : DIRECTORY READ ERROR
;	    <Z>  : END OF DIRECTORY
;	 <NC,NZ> : NO ERRORS AND :
;	    A    : ATTRIBUTE BYTE OF THIS ENTRY
;	    B    : UPDATED, MUST BE PRESERVED
;	    D&E  : PNTR TO FHAN IN FPB (UNCHANGED)
;	    H&L  : PNTR TO NEXT DIRECTORY ENTRY
;-

GNDE:	DCR	B	;ANY MORE IN THIS BLOCK ?
	JNZ	L002	;YES
	LXI	H,FBLK-FHAN
	DAD	D	;POINT TO FBLK
	LDA	MDBLK	;GET MAX. DIRECTORY BLOCK NUMBER
	SUB	M	;SUBTRACT CURRENT BLOCK NUMBER
	RZ		;THIS WAS LAST BLOCK
	INR	M	;BUMP BLOCK NUMBER
L001:	PUSH	D	;SAVE D&E
	XCHG		;PUT PNTR IN H&L
	CALL	RD	;READ NEXT BLOCK
	POP	D	;RESTORE D&E
	MVI	B,EDIR	;SET ERROR CODE
	RC		;READ ERROR
	MVI	B,6	;SET ENTRY COUNTER
	LXI	H,DBF+2-21 ;SET DIRECTORY PNTR
L002:	PUSH	D	;SAVE D&E
	LXI	D,21	;ENTRY SIZE
	DAD	D	;STEP TO NEXT ENTRY
	POP	D	;RESTORE D&E
	MOV	A,M	;GET ATTRIBUTE BYTE
	ANA	A	;TEST ATTRIBUTE BYTE
	RET		;RETURN, NO ERRORS


;+
; OPEN - OPEN A FILE FOR INPUT OR OUTPUT
;-

OPEN:	SHLD	FPBP	;SAVE FPB PNTR
	MOV	A,M	;GET OPEN TYPE CODE
	STA	OCODE	;SAVE OPEN TYPE CODE
	LXI	D,FVER-FPB
	DAD	D	;POINT TO VERSION
	MOV	A,M	;GET VERSION
	STA	OVERS	;SAVE ORIGINAL VERSION
	LXI	D,FHAN-FSIZ-1
	INX	H	;POINT TO FSIZ ...
	INX	H	;...
	INX	H	;...
	MOV	M,D	;SET FSIZ ...
	INX	H	;... TO ...
	MOV	M,D	;... ZERO
	DAD	D	;POINT TO FHAN
	XCHG		;PUT PNTR IN D&E
	CALL	OPDIR	;"OPEN" DIRECTORY
	RC		;READ ERROR
L005:	CALL	GNDE	;GET NEXT ENTRY
	RC		;ERROR
	JZ	L011	;END OF DIRECTORY
	PUSH	H	;SAVE H&L
	PUSH	D	;SAVE D&E
	XCHG		;D&E = DIR PNTR
	LHLD	FPBP	;H&L = FPB PNTR
	MVI	C,11	;SET COUNTER
	LDAX	D	;GET ENTRY TYPE CODE
	CPI	TFREE	;IS IT "FREE" ?
	JNZ	L106	;NO
	MOV	A,M	;GET OPEN TYPE CODE
	ANI	FNEW	;"NEW" FILE ?
	JZ	L010	;NO
	INX	H	;POINT TO ATR BYTE
	MVI	M,TFILE+TPROT ;SET ATR BYTE
	PUSH	B	;SAVE B&C
	LXI	B,FSBK-FATR
	DAD	B	;POINT TO FSBK IN FPB
	XCHG		;...
	DAD	B	;POINT TO FSBK IN DIRECTORY
	XCHG		;...
	MVI	B,FLAD-FSBK ;SET COUNT
	CALL	MOVHD	;COPY PARAMETERS
	LXI	B,FDBK-FLAD
	DAD	B	;POINT TO FDBK
	POP	B	;RESTORE B&C
	LDA	DBLK	;GET DIR BLOCK NUMBER
	MOV	M,A	;SAVE IT
	INX	H
	MOV	M,B	;SAVE ENTRY NUMBER
	POP	D	;RESTORE D&E
	POP	H	;RESTORE H&L
	DCR	B	;IS THIS LAST SLOT ?
	JNZ	L011	;NO: O.K.
	MOV	C,A	;COPY DIR BLK NO.
	LDA	MDBLK	;GET MAX. DIR BLK NO.
	CMP	C	;IS THIS LAST DIR BLOCK ?
	JNZ	L011	;NO: O.K.
	CALL	L011	;CHECK FOR OTHER ERRORS
	RC		;ERROR: RETURN
	MVI	B,EDRF	;SET ERROR CODE
	STC		;INDICATE ERROR
	RET		;DIR FULL: ERROR
L106:	INX	H
L006:	DCR	C	;HAVE ALL MATCHED ?
	JZ	L007	;YES
	INX	D	;BUMP DIR PNTR
	INX	H	;BUMP FPB PNTR
	LDAX	D	;GET NEXT DIR BYTE
	CMP	M	;COMPARE WITH NEXT FPB BYTE
	JZ	L006	;MATCH
	JC	L010	;IF VERS, IT'S LESS
	MOV	A,C	;GET COUNTER
	DCR	A	;WAS THIS "VERSION" BYTE ?
	JNZ	L010	;NO
	LDA	OVERS	;GET ORIGINAL VERSION
	ANA	A	;WAS IT ZERO ?
	JNZ	L010	;NO: EXPLICIT VERSION
L007:	LDA	OCODE	;GET OPEN TYPE CODE
	ANI	FNEW	;"NEW" FILE ?
	JZ	L008	;NO
	LDAX	D	;GET VERS FROM DIRECTORY
	MOV	M,A	;STORE IN FPB
	JMP	L010	;
L008:	PUSH	B	;SAVE B&C
	MVI	B,FDBK-FVER ;SET COUNT
L009:	CALL	MOVHD	;MOVE PARAMETERS
	POP	B	;RESTORE B&C
	LDA	DBLK	;GET DIR BLOCK NUMBER
	MOV	M,A	;STORE IN FPB
	INX	H	;...
	MOV	M,B	;STORE ENTRY NUMBER
L010:	POP	D	;RESTORE D&E
	POP	H	;RESTORE H&L
	DCR	C	;FIND EXPLICIT VERSION ?
	JP	L005	;NO: CONTINUE SCAN
	LDA	OCODE	;GET OPEN TYPE CODE
	ANI	FNEW	;"NEW" FILE ?
	JZ	L013	;NO: "OLD" FILE FOUND
	MVI	B,EDFN	;SET ERROR CODE
	STC
	RET		;DUPLICATE FILENAME ERROR
L011:	LHLD	FPBP	;GET FPB PNTR
	MOV	A,M	;GET OPEN TYPE CODE
	LXI	D,FVER-FPB
	DAD	D	;POINT TO FVER
	ANI	FNEW	;"NEW" FILE ?
	LDA	OVERS	;GET ORIGINAL VERSION
	JZ	L012	;NO
	ANA	A	;TEST ORIGINAL VERSION
	JNZ	L013	;EXPLICIT VERSION REQUESTED
	INR	M	;INCREMENT VERSION
	MVI	B,EVOV	;SET ERROR CODE
	STC
	RZ		;VERSION OVERFLOW ERROR
L012:	ANA	A	;TEST ORIGINAL VERSION
	JNZ	L023	;EXPLICIT VERSION REQUESTED
	MOV	A,M	;GET "FOUND" VERSION
	ANA	A	;IS IT STILL ZERO ?
	JNZ	L013	;NO: O.K.
L023:	MVI	B,EFNF	;SET ERROR CODE
	STC
	RET		;FILE NOT FOUND
L013:	LHLD	FPBP	;GET FPB PNTR
	PUSH	H	;SAVE H&L
	LXI	D,FHAN-FPB
	DAD	D	;POINT TO FHAN
	MVI	A,-3	;SET "SUB USER" FUNCTION
	CALL	CHDLR	;CALL HANDLER
	POP	H	;GET FPB PNTR BACK
	PUSH	H	;RESAVE IT
	LXI	B,FSBK-FPB
	DAD	B	;POINT TO FSBK
	MOV	E,M	;GET STARTING ...
	INX	H	;... BLOCK ...
	MOV	D,M	;... NUMBER
	LXI	B,FBLK-FSBK-1
	DAD	B	;POINT TO FBLK
	MOV	M,E	;STORE STARTING ...
	INX	H	;... BLOCK ...
	MOV	M,D	;... NUMBER
	POP	H	;RESTORE FPB POINTER
	XRA	A	;INDICATE NO ERRORS
	MOV	B,A	;SET GOOD STATUS CODE
	RET		;RETURN TO CALLER


;+
; READ - READ FILE. CURRENTLY ONLY "IMAGE"
;	 TYPE FILES ARE SUPPORTED.
;	 "OPEN" MUST BE CALLED BEFORE CALLING "READ".
;
; INPUTS  - B&C: MAX. ALLOWABLE BYTE COUNT
;	    D&E: IF ZERO, THEN FILE WILL BE READ IN TO
;		 MEMORY AT LOAD ADDRESS SPECIFIED IN
;		 DIRECTORY. IF NON-ZERO, THEN D&E IS
;		 USED AS THE LOAD ADDRESS.
;	    H&L: PNTR TO FPB.
;
;-

READ:	CALL	LADSB	;SETUP MEM. PNTR & GET SIZE
	PUSH	B	;SAVE MAX. BYTE COUNT
	MOV	C,M	;GET LAST BLK BC
	XCHG		;H&L=NUMBER OF BLOCKS
	CALL	BK2BC	;COMPUTE BYTE COUNT
	XCHG		;D&E=TOTAL BYTE COUNT
	XTHL		;GET MAX. BYTE COUNT
	CALL	CMPHD	;COMPARE WITH FILE SIZE
	POP	H	;RESTORE H&L
	MVI	B,ERSZ	;SET ERROR CODE
	RC		;FILE TOO LARGE: ERROR
	LXI	B,FXBC-FLBC
	DAD	B	;POINT TO FXBC
	MOV	M,E	;STORE ...
	INX	H	;... BYTE ...
	MOV	M,D	;... COUNT
	LXI	B,FHAN-FXBC-1
	DAD	B	;POINT TO FHAN
	CALL	RD	;READ THE FILE
	MVI	B,EFRD	;SET ERROR CODE
RWE:	LHLD	FPBP	;RESTORE FPB PNTR
	RC		;ERROR EXIT
	MVI	B,0	;SET GOOD STATUS CODE
	RET		;EXIT


;+
; WRITE - FILE WRITE. CURRENTLY ONLY "IMAGE" TYPE
;	  FILES ARE SUPPORTED. "OPEN" MUST BE
;	  CALLED BEFORE CALLING "WRITE".
;
;-

WRITE:	PUSH	H	;SAVE FPB PNTR
	PUSH	D	;SAVE AUX. LOAD ADDRESS
	LXI	D,FXBC-FPB
	DAD	D	;POINT TO FXBC
	POP	D	;RESTORE AUX. LOAD ADDRESS
	MOV	M,C	;STORE ...
	INX	H	;... BYTE ...
	MOV	M,B	;... COUNT
	POP	H	;RESTORE FPB POINTER
	CALL	LADSB	;SETUP MEM. PNTR & GET SIZE
	PUSH	B	;PUT BYTE COUNT ON STACK
	XTHL		;NOW HL=BYTE COUNT
	CALL	BC2BK	;CONVERT TO BLOCKS & BYTE COUNT
	CALL	CMPDH	;COMPARE H&L WITH D&E
	XCHG		;D&E=NUMBER OF BLOCKS
	POP	H	;H&L=PNTR TO FLBC
	MVI	B,EWSZ	;SET ERROR CODE
	RC		;ERROR EXIT
	MOV	M,C	;STORE LAST BLOCK BYTE COUNT
	LXI	B,FAUX-FLBC
	DAD	B	;POINT TO FAUX
	MOV	M,E	;STORE NUMBER ...
	INX	H	;... OF BLOCKS ...
	MOV	M,D	;... USED
	INX	H	;POINT TO FHAN
	CALL	WR	;WRITE THE FILE
	MVI	B,EFWR	;SET ERROR CODE
	JMP	RWE	;TAKE COMMON EXIT

WR:	MVI	A,1	;SET "WRITE" FUNCTION CODE
	DB	0FEH	;** SKIP ONE BYTE **
RD:	XRA	A	;SET "READ" FUNCTION CODE
CHDLR:	MOV	E,M	;GET ...
	INX	H	;... HANDLER ...
	MOV	D,M	;... ADDRESS
	INX	H	;POINT TO PARAMETER BLOCK
	MOV	M,A	;STORE FUNCTION CODE
JMPD:	PUSH	D	;JUMP INDIRECT ...
	RET		;... D&E


LADSB:	SHLD	FPBP	;SAVE FPB PNTR
	MOV	A,D	;TEST AUX. ...
	ORA	E	;... LOAD ADDRESS
	JNZ	L014	;NON-ZERO: USE IT
	PUSH	H	;SAVE H&L
	LXI	D,FLAD-FPB
	DAD	D	;POINT TO FLAD
	MOV	E,M	;GET LOBYTE
	INX	H	;...
	MOV	D,M	;GET HIBYTE
	POP	H	;RESTORE H&L
L014:	PUSH	D	;SAVE D&E
	LXI	D,FBUF-FPB
	DAD	D	;POINT TO FBUF
	POP	D	;RESTORE D&E
	MOV	M,E	;STORE LOAD ...
	INX	H	;... ADDRESS IN ...
	MOV	M,D	;... FBUF
	LXI	D,FSIZ-FBUF-1
	DAD	D	;POINT TO FSIZ
	MOV	E,M	;GET NUMBER ...
	INX	H	;... OF ...
	MOV	D,M	;... BLOCKS
	INX	H	;POINT TO FLBC
	RET		;RETURN


;+
; CLOSE - FILE CLOSE ROUTINE.
;
;-

CLOSE:	MVI	B,0	;SET GOOD STATUS CODE
	MOV	A,M	;GET OPEN TYPE CODE
	ANI	FNEW	;"NEW" FILE ?
	RZ		;NO: RETURN
	SHLD	FPBP	;SAVE FPB PNTR
	CALL	GODBK	;GET DIRECTORY BLOCK
	RC		;ERROR
	LXI	D,FAUX-FPB
	DAD	D	;POINT TO FAUX
	MOV	E,M	;GET NUMBER ...
	INX	H	;... OF BLOCKS ...
	MOV	D,M	;... IN FILE
	PUSH	D	;SAVE FILE BLOCKS
	LXI	D,FSBK-FAUX-1
	DAD	D	;POINT TO FSBK
	MOV	E,M	;GET FILE ...
	INX	H	;... STARTING ...
	MOV	D,M	;... BLOCK NUMBER
	INX	H	;POINT TO FSIZ
	XTHL		;SAVE PNTR & GET FILE BLOCKS
	XCHG		;D&E=FILE BLOCKS
	DAD	D	;H&L=START BLK OF FREE SPACE
	XTHL		;SAVE H&L & GET PNTR
	PUSH	D	;SAVE FILE BLOCKS
	MOV	E,M	;GET TOTAL ...
	INX	H	;... BLOCKS IN ...
	MOV	D,M	;... "FREE" SLOT
	XTHL		;SAVE PNTR & GET FILE BLOCKS
	XCHG		;H&L=OLD "FREE" BLOCKS
	CALL	SUBHD	;COMPUTE NEW "FREE" BLOCKS
	XTHL		;SAVE NEW "FREE" & GET PNTR
	MOV	M,D	;STORE NUMBER ...
	DCX	H	;... OF BLOCKS ...
	MOV	M,E	;... IN FILE
	LXI	D,FATR-FSIZ
	DAD	D	;POINT TO FATR
	PUSH	B	;SAVE B&C
	PUSH	H	;SAVE PNTR
	LXI	H,DBF+2+6*21 ;POINT PAST LAST DIR ENTRY
	LXI	D,-21	;ENTRY SIZE
L017:	DAD	D	;STEP BACK ONE ENTRY
	DCR	B	;AT CORRECT ENTRY ?
	JNZ	L017	;NO: STEP AGAIN
	POP	D	;GET PNTR TO FATR
	MVI	B,21	;SET COUNT
	CALL	MOVHD	;MOVE DIRECTORY ENTRY
	POP	B	;GET OLD B&C
	DCR	B	;WAS THIS LAST DIR. SLOT ?
	CZ	L025	;YES: STORE BLK NO., ETC.
	POP	B	;GET SIZE
	POP	D	;GET START BLK. NO.
	CALL	SFR	;STORE SIZE & START BLK. NO.
WRDIR:	LXI	D,DBF	;POINT TO DIRECTORY BUFFER
	CALL	SUBHD	;COMPUTE DIRECTORY BYTE COUNT
	XCHG		;D&E = BYTE COUNT
	LHLD	FPBP	;GET FPB PNTR
	LXI	B,FXBC-FPB
	DAD	B	;POINT TO FXBC
	MOV	M,E	;STORE ...
	INX	H	;... BYTE ...
	MOV	M,D	;... COUNT
	LXI	D,FHAN-FXBC-1
	DAD	D	;POINT TO FHAN
	CALL	WR	;WRITE DIRECTORY
	MVI	B,0	;SET GOOD STATUS CODE
	LHLD	FPBP	;GET FPB PNTR
	RNC		;O.K.: EXIT
	MVI	B,EDIR	;SET ERROR CODE
	RET		;ERROR EXIT

SFR:	MVI	M,TFREE	;SET 'FREE' ATTRIBUTE BYTE
	PUSH	D
	LXI	D,FSBK-FATR
	DAD	D	;POINT TO FSBK
	POP	D
	MOV	M,E	;STORE START ...
	INX	H	;... BLOCK NUMBER ...
	MOV	M,D	;... OF FREE SPACE
	INX	H
	MOV	M,C	;STORE ...
	INX	H	;... SIZE OF ...
	MOV	M,B	;... FREE SPACE ...
	INX	H
	MVI	M,128	;STORE LBC
	INX	H
	RET		;RETURN

L025:	LDA	MDBLK	;GET MAX. DIR. BLK. NO.
	CMP	C	;IS THIS THE LAST BLOCK ?
	RZ		;YES: RETURN
	INR	C	;BUMP BLOCK NUMBER
	MOV	M,C	;STORE IT
	INX	H
	MOV	M,A	;STORE MAX. BLK. NO.
	INX	H
	RET		;RETURN TO CALLER


GODBK:	LHLD	FPBP	;GET FPB PNTR
	PUSH	H	;SAVE IT
	LXI	D,FDBK-FPB
	DAD	D	;POINT TO FDBK
	MOV	C,M	;GET DIRECTORY BLOCK NUMBER
	INX	H	;POINT TO FDEN
	MOV	B,M	;GET DIRECTORY ENTRY NUMBER
	LXI	D,FBLK-FDEN
	DAD	D	;POINT TO FBLK
	MOV	M,C	;STORE BLOCK NUMBER
	INX	H
	LXI	D,DIP+1	;POINT TO REST OF PARAMETERS
	PUSH	B	;SAVE B&C
	MVI	B,DIPS-1 ;SET COUNT
	CALL	MOVHD	;STORE REST OF PARAMETERS
	POP	B	;RESTORE B&C
	PUSH	B	;RESAVE B&C
	LXI	D,FHAN-FXBC-2
	DAD	D	;POINT TO FHAN
	CALL	RD	;READ DIR BLOCK
	POP	B	;RESTORE B&C
	POP	H	;RESTORE FPB PNTR
	RNC		;NO ERRORS
	MVI	B,EDIR	;SET ERROR CODE
	RET		;RETURN TO CALLER


;+
; PDV - PARSE DEVICE NAME
; <C> : INVALID DEVICE
; <Z> : NO DEVICE, DEFAULT USED
; OTHERWISE: GOT VALID DEVICE
;-

PDV:	CALL	SPNOR	;SKIP SPACES
	PUSH	D	;SAVE FPB PNTR
	PUSH	H	;SAVE STRING PNTR
	XCHG
	LHLD	DFDV	;GET DEFAULT DEVICE
	XCHG		;PUT IN D&E
	LDA	DFUN	;GET DEFAULT UNIT NUMBER
	MOV	C,A	;PUT IN C
	MOV	A,M	;TEST IF ...
	ANA	A	;... END OF LINE
	JZ	PDV05	;END OF LINE
	MVI	B,4	;SET COUNTER
PDV01:	DCR	B	;ENOUGH ?
	JZ	PDV05	;YES: NO DEVICE
	INX	H
	MOV	A,M	;GET NEXT CHARACTER
	ANA	A	;TEST FOR END OF LINE
	JZ	PDV05	;END OF LINE: NO DEVICE
	CPI	':'	;CHECK FOR COLON
	JNZ	PDV01	;NO: LOOP
PDV02:	POP	H	;RESTORE STRING PNTR
	MVI	A,3
	CMP	B
	JZ	PDV03	;UNIT NUMBER ONLY
	MOV	E,M	;GET ...
	INX	H	;... DEVICE ...
	MOV	D,M	;... NAME
	INX	H
	MVI	C,'0'	;SET UNIT ZERO
PDV03:	DCR	B
	DCR	B
	JZ	PDV04	;NO UNIT NUMBER
	MOV	C,M	;GET UNIT NUMBER
	INX	H
PDV04:	INX	H	;SKIP OVER COLON
	PUSH	H	;SAVE STRING POINTER
	ANA	A	;SET FLAGS TO <NZ>
PDV05:	POP	H	;GET STRING PNTR
	XTHL		;SWAP
	PUSH	PSW	;SAVE FLAGS
	MOV	A,C	;COPY UNIT NUMBER
	SUI	'0'	;CONVERT FROM ASCII
	PUSH	PSW	;SAVE UNIT NUMBER
	PUSH	H	;SAVE ORIGINAL D&E
	LXI	H,HDVCT	;POINT TO DEVICE TABLE
	MVI	C,3	;SET NUMBER OF SLOTS
PDV06:	PUSH	H	;SAVE HANDLER PNTR
	MVI	A,0C3H	;SET 'JMP' BYTE
	XRA	M	;VECTOR EMPTY ?
	JNZ	PDV07	;YES: SKIP IT
	INX	H	;POINT TO ASCII DEVICE NAME ...
	INX	H
	INX	H
	MOV	A,M	;GET 1ST CHAR. OF NAME
	CMP	E	;MATCH ?
	JNZ	PDV07	;NO: GO TRY NEXT DEVICE
	INX	H
	MOV	A,M	;GET 2ND CHAR. OF NAME
	CMP	D	;MATCH ?
	JNZ	PDV07	;NO: GO TRY NEXT DEVICE
	INX	H	;POINT TO NUMBER OF UNITS
	MOV	H,M	;GET NUMBER OF UNITS
	POP	B	;GET HANDLER PNTR
	POP	D	;RESTORE D&E
	POP	PSW	;GET UNIT NUMBER
	CMP	H	;VALID UNIT NUMBER ?
	JNC	PDV08	;NO: ERROR
	LXI	H,FHAN-FPB
	DAD	D	;POINT TO FHAN IN FPB
	MOV	M,C	;STORE ...
	INX	H	;... HANDLER ...
	MOV	M,B	;... ADDRESS
	INX	H
	INX	H
	MOV	M,A	;STORE UNIT NUMBER
	POP	PSW	;RESTORE FLAGS
	POP	H	;RESTORE STRING PNTR
	STC		;CLEAR ...
	CMC		;... C-FLAG
	MVI	B,EMDV	;SET ERROR CODE
	RET		;EXIT
PDV07:	POP	H	;GET HANDLER PNTR
	MOV	A,C	;SAVE COUNTER
	LXI	B,10
	DAD	B	;STEP TO NEXT HANDLER
	MOV	C,A	;COPY COUNTER BACK
	DCR	C	;ANY MORE DEVICES ?
	JNZ	PDV06	;YES: TRY NEXT DEVICE
	POP	D	;RESTORE D&E
	POP	PSW	;DISCARD UNIT NUMBER
PDV08:	POP	PSW	;RESTORE FLAGS
	POP	H	;RESTORE STRING PNTR
	MVI	B,EIVD	;SET ERROR CODE
	STC		;INDICATE ENVALID DEVICE
	RET		;EXIT


PSFSP:	LXI	B,STYP	;SET DEFAULT TYPE 'SRC'
	JMP	PFSPC
PNFSP:	LXI	B,NTYP	;SET BLANK DEFAULT TYPE
	JMP	PFSPC
PPFSP:	LXI	B,PTYP	;SET DEFAULT TYPE 'PRG'
PFSPC:	PUSH	H	;SAVE STRING PNTR
	PUSH	D	;SAVE FPB PNTR
	PUSH	B	;SAVE DEFAULT TYPE PNTR
	LXI	H,FTYP-FPB
	DAD	D	;POINT TO TYPE
	XCHG		;PNTR IN D&E
	POP	H	;GET DEFAULT TYPE PNTR
	MVI	B,3	;SET COUNT
	CALL	MSTR	;MOVE DEFAULT TYPE IN
	POP	D	;RESTORE FPB PNTR
	POP	H	;RESTORE STRING PNTR
PCFSP:	CALL	PDV	;PARSE DEVICE NAME
	RC		;ERROR
	PUSH	D	;SAVE FPB PNTR
	INX	D
	INX	D	;POINT TO NAME
	CALL	LODG	;LETTER OR DIGIT ?
	JNC	PFS04	;NO: NO NAME
	MVI	B,6	;SET COUNT
	CALL	MSTR	;MOVE NAME IN
	MOV	A,M	;GET NEXT CHAR.
	CPI	'.'	;IS THERE A TYPE ?
	JZ	PFS01	;YES
	INX	D	;SKIP ...
	INX	D	;... OVER ...
	INX	D	;... TYPE
	JMP	PFS02	;
PFS01:	INX	H	;SKIP OVER '.'
	MVI	B,3	;SET COUNT
	CALL	MSTR	;MOVE TYPE IN
PFS02:	XRA	A	;CLEAR A
	STAX	D	;STORE ZERO VERSION NUMBER
	MOV	A,M	;GET NEXT CHAR.
	CPI	';'	;IS THERE A VERSION ?
	JNZ	PFS03	;NO
	INX	H	;SKIP OVER ';'
	PUSH	D	;SAVE PNTR TO VERSION
	CALL	GN2Z	;GET NUMBER
	MOV	A,E	;USE LOBYTE OF NUMBER
	POP	D	;RESTORE PNTR TO VERSION
	STAX	D	;STORE VERSION NUMBER
PFS03:	LDAX	D	;GET VERSION NUMBER
	POP	D	;RESTORE FPB PNTR
	MVI	B,EMVR	;SET STATUS CODE
	ANA	A	;TEST VERSION NUMBER
	RET		;RETURN TO CALLER
PFS04:	POP	D	;RESTORE FPB PNTR
	MVI	B,EMFN	;SET ERROR CODE
	STC		;INDICATE ERROR
	RET		;RETURN TO CALLER



;+
;    THIS IS AN INITIAL SET OF ROUTINES TO FACILITATE FILE
; OPERATIONS WITH THE FCS SYSTEM. ROUTINES ARE PROVIDED
; FOR SEQUENTIAL BYTE ACCESS, SEQUENTIAL RECORD ACCESS,
; AND BLOCK ACCESS.
;
;    CERTAIN PARAMETERS IN THE FILE PARAMETER BLOCK (FPB)
; MUST BE SET UP BEFORE USING ANY OF THESE ROUTINES. THESE
; PARAMETERS SHOULD BE SET UP AFTER CALLING 'OPEN' TO OPEN
; THE FILE, BUT BEFORE ANY CALL TO ANY OF THESE ACCESS
; ROUTINES.
;
;    THE PARAMETERS ARE :
;
; FBUF - SHOULD BE SET TO THE ADDRESS OF THE USER-PROVIDED
;	  BLOCK BUFFER.
;
; FXBC - FOR SEQUENTIAL ACCESS, SHOULD BE SET TO THE SIZE
;	  (NUMBER OF BYTES) OF THE USER-PROVIDED BLOCK BUFFER.
;	  THE SIZE SHOULD BE A MULTIPLE OF THE SYSTEM STANDARD
;	  BLOCK SIZE, 128 DECIMAL.
;	 FOR DIRECT BLOCK ACCESS, SHOULD BE SET TO THE NUMBER
;	  OF BYTES TO BE TRANSFERRED.
;
;    WHEN USING SEQUENTIAL BYTE OR RECORD ACCESS, THESE
; PARAMETERS SHOULD NOT BE CHANGED DURING THE I/O OPERATIONS.
;    WHEN USING DIRECT BLOCK ACCESS, THESE PARAMETERS MAY
; BE SET TO THE DESIRED VALUES FOR THE TRANSFER, PRIOR TO
; EACH CALL TO RBLK, RBLKI, WBLK, OR WBLKI. THEY'RE VALUES
; ARE PRESERVED BY THE BLOCK I/O ROUTINES, SO THEY
; DO NOT NEED TO BE RESET PRIOR TO EACH CALL UNLESS
; YOU SPECIFICALLY WANT TO CHANGE EITHER THE LOCATION
; OR THE SIZE OF THE BUFFER.
;
;   SEE THE INDIVIDUAL DESCRIPTION FOR DETAILS ON EACH
; OF THE FOLLOWING ACCESS ROUTINES.
;-


;+
; *** RWSEQI *** - "REWIND SEQUENTIAL INPUT" ROUTINE
;
;  RWSEQI IS USED TO "REWIND" A SEQUENTIAL INPUT FILE.
;
;  RWSEQI MUST BE CALLED BEFORE THE FIRST CALL TO ANY
;  OF THE SEQUENTIAL BYTE OR RECORD INPUT ROUTINES
;
; INPUTS:  HL => FPB
;
; OUTPUTS: A - LOST
;	   BC,DE - UNCHANGED
;	   HL => FPB
;
; STATUS:  NONE
;-

RWSEQI:	PUSH	H	;SAVE FPB PTR
	PUSH	D
	XRA	A	;CLEAR A REGISTER
	LXI	D,FBLK-FPB
	DAD	D	;POINT TO FBLK
	MOV	M,A	;SET VIRTUAL BLOCK = 0 ...
	INX	H
	MOV	M,A
	LXI	D,FAUX-FBLK-1
	DAD	D	;POINT TO AUX. BYTE COUNT
	MOV	M,A	;INITIALIZE AUX. BYTE COUNT ...
	INX	H
	MOV	M,A
	POP	D
	POP	H	;RESTORE FPB PTR
;
ZPTR:	PUSH	H	;SAVE FPB PTR
	PUSH	D
	LXI	D,FPTR-FPB
	DAD	D	;POINT TO RELATIVE BUFFER POINTER
	MVI	M,0	;ZERO IT ...
	INX	H
	MVI	M,0
	POP	D
	POP	H	;RESTORE FPB PTR
	RET


;+
; *** INSEQO *** "INITIALIZE SEQUENTIAL OUTPUT" ROUTINE
;
;  INSEQO IS USED TO INITIALIZE A NEWLY CREATED OPEN FILE
;  FOR SEQUENTIAL BYTE OR RECORD OUTPUT OPERATIONS.
;
;  INSEQO MUST BE CALLED BEFORE THE FIRST CALL TO ANY OF
;  THE SEQUENTIAL BYTE OR RECORD OUTPUT ROUTINES
;
; INPUTS:  HL => FPB
;
; OUTPUTS: A - LOST
;	   BC,DE - UNCHANGED
;	   HL => FPB
;
; STATUS:  NONE
;-

INSEQO:	CALL	RWSEQI	;INITIALIZE THINGS
	PUSH	D
	PUSH	B
	LXI	D,0	;VIRTUAL BLOCK ZERO
	CALL	CBC	;SETUP THINGS
	POP	B
	POP	D
	RET		;EXIT
;
CBC:	PUSH	H	;SAVE FPB PTR
	LXI	B,FSIZ-FPB
	DAD	B	;POINT TO FSIZ
	MOV	A,M	;GET IT ...
	INX	H
	MOV	H,M
	MOV	L,A
	CALL	CMPDH	;COMPARE WITH VIRTUAL BLOCK NUMBER
	JC	CBC1	;O.K.: VALID BLOCK NUMBER
	POP	H	;RESTORE FPB PTR
	XRA	A
	STC
	RET		;<C><Z>: INVALID BLOCK NUMBER
CBC1:	CALL	SUBHD	;COMPUTE NUMBER OF REMAINING BLOCKS
	XCHG
	POP	H	;GET FPB PTR
	PUSH	H	;SAVE FPB PTR
	LXI	B,FXBC-FPB
	DAD	B	;POINT TO FXBC
	MOV	A,M	;GET BUFFER SIZE ...
	INX	H
	MOV	H,M
	MOV	L,A
	CALL	BC2BK	;CONVERT TO NUMBER OF BLOCKS
	CALL	CMPHD	;ENTIRE BUFFER O.K. ?
	JC	CBC2	;YES
	POP	H	;GET FPB PTR
	PUSH	H	;SAVE FPB PTR
	LXI	B,FLBC-FPB
	DAD	B	;POINT TO LAST BLOCK BYTE COUNT
	MOV	C,M	;GET IT
	XCHG		;HL = REMAINING BLOCKS
CBC2:	CALL	BK2BC	;CONVERT TO BYTE COUNT
	XCHG
	POP	H	;GET FPB PTR
	PUSH	H	;SAVE FPB PTR
	LXI	B,FAUX-FPB
	DAD	B	;POINT TO AUX. BYTE COUNT
	MOV	M,E	;SET IT ...
	INX	H
	MOV	M,D
	POP	H	;RESTORE FPB PTR
	RET		;<NC>: O.K.


;+
; *** CLSEQO *** "CLOSE SEQUENTIAL OUTPUT" ROUTINE
;
;  CLSEQO IS USED TO CLOSE A NEWLY CREATED SEQUENTIAL
;  OUTPUT FILE. THE REMAINING UNWRITTEN PART OF THE BLOCK
;  BUFFER IS WRITTEN OUT, IF ANY, AND THE FINAL FILE SIZE
;  IS CALCULATED AND APPROPRIATE INFORMATION UPDATED IN
;  THE FPB. THEN 'CLOSE' IS CALLED TO ENTER THE FILE INTO
;  THE DIRECTORY.
;
; INPUTS:  HL => FPB
;
; OUTPUTS: A,BC,DE - LOST
;	   HL => FPB IF NO ERRORS, ELSE HL LOST
;
; STATUS:  <NC> - NO ERRORS, B=0
;	   <C>  - FILE WRITE ERROR OR DIRECTORY WRITE ERROR,
;		  WITH B = SYSTEM ERROR CODE
;-

CLSEQO:	PUSH	H	;SAVE FPB PTR
	LXI	D,FPTR-FPB
	DAD	D	;POINT TO RELATIVE BUFFER POINTER
	MOV	E,M	;GET IT ...
	INX	H
	MOV	D,M
	LXI	B,FLBC-FPTR-1
	DAD	B	;POINT TO LAST BLOCK BYTE COUNT
	XCHG
	CALL	BC2BK	;CONVERT TO BLOCKS & LAST BLOCK BYTE COUNT
	XCHG
	MOV	M,C	;SET LAST BLOCK BYTE COUNT
	LXI	B,FBLK-FLBC
	DAD	B	;POINT TO NEXT VIRTUAL BLOCK
	MOV	A,M	;GET IT ...
	INX	H
	MOV	H,M
	MOV	L,A
	DAD	D	;COMPUTE ACTUAL FILE SIZE
	XCHG
	POP	H	;GET FPB PTR
	PUSH	H	;SAVE FPB PTR
	LXI	B,FSIZ-FPB
	DAD	B	;POINT TO FILE SIZE
	MOV	C,M	;GET IT ...
	INX	H
	MOV	B,M
	MOV	M,D	;SET ACTUAL FILE SIZE ...
	DCX	H
	MOV	M,E
	POP	H	;RESTORE FPB PTR
	PUSH	B	;SAVE ORIGINAL FILE SIZE
	CALL	IWBKI	;WRITE REMAINING PART OF BUFFER
	POP	B	;GET ORIGINAL FILE SIZE
	PUSH	PSW	;SAVE STATUS
	PUSH	H	;SAVE FPB PTR
	LXI	D,FSIZ-FPB
	DAD	D	;POINT TO FILE SIZE
	MOV	E,M	;GET ACTUAL FILE SIZE ...
	INX	H
	MOV	D,M
	MOV	M,B	;RESTORE ORIGINAL FILE SIZE ...
	DCX	H
	MOV	M,C
	LXI	B,FAUX-FSIZ
	DAD	B	;POINT TO ACTUAL FILE SIZE
	MOV	M,E	;SET ACTUAL FILE SIZE FOR CLOSE ...
	INX	H
	MOV	M,D
	POP	H	;RESTORE FPB PTR
	POP	PSW	;RESTORE STATUS
	MVI	B,EFWR
	RC		;<C>: FILE WRITE ERROR
	JMP	CLOSE	;CLOSE THE FILE AND EXIT


;+
; *** RBLK *** "READ BLOCK" ROUTINE
; *** WBLK *** "WRITE BLOCK" ROUTINE
;
;  RBLK AND WBLK ARE USED TO READ/WRITE TO/FROM A
;  SPECIFIED VIRTUAL BLOCK NUMBER IN A FILE.
;
; INPUTS:  HL => FPB
;	 FBLK =  DESIRED STARTING VIRTUAL BLOCK NUMBER
;	 FBUF => BLOCK BUFFER
;	 FXBC = NUMBER OF BYTES TO READ/WRITE
;
; OUTPUTS: A - LOST
;	   BC,DE - UNCHANGED
;	   HL => FPB
;	   FBLK,FBUF,FXBC - UNCHANGED
;
; STATUS:  <NC><Z> - NO ERRORS:
;	     FAUX= NUMBER OF BYTES TRANSFERRED = (FXBC).
;	   <NC><NZ> - TRANSFER TRUNCATED BY END-OF-FILE
;	     FAUX= NUMBER OF BYTES TRANSFERRED < (FXBC).
;	   <C><Z> - VIRTUAL BLOCK NOT WITHIN FILE:
;	     FAUX UNCHANGED.
;	   <C><NZ><M> - READ/WRITE ERROR:
;	     FAUX = NUMBER OF BYTES ATTEMPTED.
;-

WBLK:	MVI	A,1	;SET WRITE FUNCTION CODE
	DB	0FEH	;*** SKIP ONE BYTE *** (CPI)
RBLK:	XRA	A	;SET READ FUNCTION CODE
	PUSH	D
	PUSH	B
	CALL	RWBCM	;DO THE TRANSFER
	POP	B
	POP	D
	RET		;EXIT

IWBK:	MVI	A,1	;SET WRITE FUNCTION CODE
	DB	0FEH	;*** SKIP ONE BYTE *** (CPI)
IRBK:	XRA	A	;SET READ FUNCTION CODE
RWBCM:	PUSH	H	;SAVE FPB PTR
	LXI	D,FFCN-FPB
	DAD	D	;POINT TO HANDLER FUNCTION CODE
	MOV	M,A	;SET FUNCTION CODE
	LXI	D,FBLK-FFCN
	DAD	D	;POINT TO VIRTUAL BLOCK NUMBER
	MOV	E,M	;GET IT
	INX	H
	MOV	D,M
	POP	H	;GET FPB PTR
	CALL	CBC	;CALL COMMON ROUTINE
	RC		;<C><Z>: INVALID BLOCK NUMBER
	LXI	B,FXBC-FPB
	DAD	B	;POINT TO FXBC
	MOV	C,M	;GET REQUESTED BYTE COUNT
	INX	H
	MOV	B,M
	PUSH	B	;SAVE REQUESTED BYTE COUNT
	MOV	M,D	;SET BYTE COUNT FOR XFER
	DCX	H
	MOV	M,E
	LXI	B,FSBK-FXBC
	DAD	B	;POINT TO STARTING BLOCK NUMBER
	MOV	E,M	;GET IT ...
	INX	H
	MOV	D,M
	LXI	B,FBLK-FSBK-1
	DAD	B	;POINT TO VIRTUAL BLOCK NUMBER
	MOV	C,M	;GET IT ...
	INX	H
	MOV	B,M
	PUSH	B	;SAVE VIRTUAL BLOCK NUMBER
	XCHG
	DAD	B	;COMPUTE ABSOLUTE BLOCK NUMBER
	XCHG
	MOV	M,D	;SET ABSOLUTE BLOCK NUMBER ...
	DCX	H
	MOV	M,E
	PUSH	H	;SAVE PTR TO FBLK
	LXI	B,FHAN-FBLK
	DAD	B	;POINT TO FHAN
	MOV	E,M	;GET HANDLER ADDRESS
	INX	H
	MOV	D,M
	INX	H
	CALL	JMPD	;PERFORM THE READ/WRITE
	POP	H	;GET POINTER TO FBLK
	POP	D	;GET VIRTUAL BLOCK NUMBER
	MOV	M,E	;RESTORE VIRTUAL BLOCK NUMBER
	INX	H
	MOV	M,D
	PUSH	PSW	;SAVE HANDLER STATUS
	LXI	B,FXBC-FBLK-1
	DAD	B	;POINT TO FXBC
	POP	PSW	;RESTORE HANDLER STATUS
	POP	B	;GET REQUESTED BYTE COUNT
	MOV	E,M	;GET ATTEMPTED BYTE COUNT
	INX	H
	MOV	D,M
	MOV	M,B	;RESTORE REQUESTED BYTE COUNT
	DCX	H
	MOV	M,C
	JC	RWB1	;ERROR DURING TRANSFER
	PUSH	H	;SAVE POINTER TO FXBC
	MOV	H,B
	MOV	L,C
	CALL	CMPHD	;CHECK IF ATTEMPTED = REQUESTED
	POP	H	;RESTORE POINTER TO FXBC
	JMP	RWB2	;FINISH CLEANUP & EXIT
RWB1:	ORI	-1
	STC		;<C><NZ><M>: I/O ERROR STATUS
RWB2:	PUSH	PSW	;SAVE STATUS
	LXI	B,FPB-FXBC
	DAD	B	;RESTORE FPB PTR
	POP	PSW	;RESTORE CONDITION CODES
	RET		;EXIT


;+
; *** RBLKI *** "READ BLOCK & INCREMENT" ROUTINE
; *** WBLKI *** "WRITE BLOCK & INCREMENT" ROUTINE
;
;  RBLKI AND WBLKI ARE IDENTICAL IN FUNCTION TO
;  RBLK AND WBLK EXCEPT: IF NO ERRORS OCCURRED, THEN
;  FBLK IS SET TO THE NEXT VIRTUAL BLOCK NUMBER
;  FOR SEQUENTIAL ACCESS. IF ANY ERRORS OCCURRED,
;  THEN FBLK IS UNCHANGED.
;-

WBLKI:	MVI	A,1	;SET WRITE FUNCTION CODE
	DB	0FEH	;*** SKIP ONE BYTE *** (CPI)
RBLKI:	XRA	A	;SET READ FUNCTION CODE
	PUSH	D
	PUSH	B
	CALL	RWICM	;DO THE TRANSFER
	POP	B
	POP	D
	RET		;EXIT

IWBKI:	MVI	A,1	;SET WRITE FUNCTION CODE
	DB	0FEH	;*** SKIP ONE BYTE *** (CPI)
IRBKI:	XRA	A	;SET READ FUNCTION CODE
RWICM:	CALL	RWBCM	;DO THE TRANSFER
	RC		;INVALID BLOCK OR READ/WRITE ERROR
	PUSH	PSW	;SAVE CONDITION CODES
	LXI	B,FBLK-FPB
	DAD	B	;POINT TO VIRTUAL BLOCK NUMBER
	PUSH	H	;SAVE PTR TO FBLK
	MOV	A,M	;GET VIRTUAL BLOCK NUMBER
	INX	H
	MOV	H,M
	MOV	L,A
	XCHG		;HL = BYTES TRANSFERED
	CALL	BC2BK	;CONVERT TO BLOCKS
	DAD	D	;COMPUTE NEXT VIRTUAL BLOCK NUMBER
	XCHG
	POP	H	;GET PTR TO FBLK
	MOV	M,E	;SET NEXT VIRTUAL BLOCK NUMBER ...
	INX	H
	MOV	M,D
	LXI	B,FPB-FBLK-1
	DAD	B	;RESTORE FPB PTR
	POP	PSW	;RESTORE CONDITION CODES
	RET		;EXIT: EITHER <NC><Z> OR <NC><NZ>


;+
; *** GTBYT *** "GET BYTE" ROUTINE
;
;  GTBYT IS USED TO READ SEQUENTIAL BYTES FROM AN OPEN
;  FILE.
;
;  RWSEQI MUST HAVE BEEN CALLED BEFORE THE FIRST CALL
;  TO GTBYT
;
;  INPUTS:	HL => FPB
;
;  OUTPUTS:	A = TEH BYTE, IF NO ERRORS
;		BC,DE - UNCHANGED
;		HL => FPB
;
;  STATUS:	<NC> - NO ERRORS, A= THE BYTE
;		<C><Z> - END OF FILE
;		<C><NZ><M> - READ ERROR
;-

GB1:	POP	H	;RESTORE FPB PTR
	CALL	RBLKI	;READ BUFFERFULL
	RC		;END-OF-FILE OR READ ERROR
	CALL	ZPTR	;RESET RELATIVE BUFFER POINTER
GTBYT:	PUSH	H	;SAVE FPB PNTR
	CALL	BCHK	;NEED TO READ NEXT BUFFERFULL ?
	JNC	GB1	;YES
	XRA	A	;SET GOOD CODES
	MOV	A,M	;GET THE BYTE
	POP	H	;RESTORE FPB PTR
	RET		;<NC>: NO ERROR


;+
; *** PTBYT *** "PUT BYTE" ROUTINE
;
;  PTBYT IS USED TO WRITE SEQUENTIAL BYTES TO AN OPEN FILE.
;
;  INSEQO MUST BE CALLED AFTER OPEN AND BEFORE THE FIRST
;  CALL TO PTBYT
;
; INPUTS:	A = THE BYTE
;		HL => FPB
;
; OUTPUTS:	A = THE BYTE
;		BC,DE - UNCHANGED
;		HL => FPB
;
; STATUS:	<NC> - NO ERRORS
;		<C><Z> - FILE FULL, BYTE NOT WRITTEN
;		<C><NZ><M> - WRITE ERROR
;-

PB1:	POP	H	;GET THE BYTE
	XCHG		;D = THE BYTE
	XTHL		;GET FPB PTR, SAVE ORIG. DE
	PUSH	B	;SAVE BC
	PUSH	D	;SAVE THE BYTE
	CALL	IWBKI	;WRITE THE BUFFER OUT
	CNC	CBC	;CALL COMMON ROUTINE IF NO ERROR
	POP	D	;GET THE BYTE BACK
	MOV	A,D	;... INTO A
	POP	B	;RESTORE BC
	POP	D	;RESTORE DE
	RC		;WRITE ERROR OR FILE FULL
	CALL	ZPTR	;RESET RELATIVE BUFFER POINTER
PTBYT:	PUSH	H	;SAVE FPB PTR
	PUSH	PSW	;SAVE THE BYTE
	CALL	BCHK	;NEED TO WRITE OUT BLOCK BUFFER ?
	JNC	PB1	;YES
	POP	PSW	;GET THE BYTE
	MOV	M,A	;PUT BYTE INTO BUFFER
	POP	H	;RESTORE FPB PTR
	ANA	A	;SET GOOD CODES
	RET		;<NC>: NO ERRORS


;+
; *** GAREC *** "GET ASCII RECORD" ROUTINE
;
;  GAREC IS USED TO READ SEQUENTIAL RECORDS FROM AN
;  ASCII FILE. A RECORD IS A STRING OF ASCII CHARACTERS
;  TERMINATED BY EITHER A LINE FEED (10.) OR A
;  FORM FEED (12.).
;
;  RWSEQI MUST HAVE BEEN CALLED BEFORE THE FIRST CALL
;  TO GAREC
;
; INPUTS:	HL => FPB
;		BC => RECORD BUFFER
;		DE =  RECORD BUFFER LENGTH (BYTES)
;
; OUTPUTS:	HL => FPB
;		BC => PAST LAST BYTE STORED
;		DE = NUMBER OF BYTES READ
;		A - LOST
;
; STATUS:	<NC> - NO ERRORS
;		<C><Z> - END OF FILE
;		<C><NZ><M> - READ ERROR
;		<C><NZ><P> - BUFFER WAS FILLED, BUT A VALID
;			     TERMINATOR WAS NOT SEEN. THE NEXT
;			     CALL TO GAREC WILL START WITH THE
;			     NEXT SEQUENTIAL BYTE.
;-

GAREC:	PUSH	D	;SAVE BUFFER LENGTH
GAR1:	CALL	GTBYT	;GET NEXT BYTE
	JC	GAR2	;ERROR OR EOF
	STAX	B	;STORE THE BYTE
	INX	B
	DCX	D	;COUNT IT
	CPI	10	;LINE FEED ?
	JZ	GAR2	;YES: <NC>: NO ERRORS
	CPI	12	;FORM FEED ?
	JZ	GAR2	;YES: <NC>: NO ERRORS
	MOV	A,D
	ORA	E	;RECORD BUFFER FULL ?
	JNZ	GAR1	;NO: GET ANOTHER BYTE
	INR	A
	STC		;<C><NZ><P>: LINE TOO LONG
GAR2:	XTHL		;GET BUFFER LENGTH
	PUSH	PSW	;SAVE STATUS
	CALL	SUBHD	;COMPUTE BYTE COUNT
	XCHG		;DE = BYTE COUNT
	POP	PSW	;RESTORE STATUS
	POP	H	;RESTORE FPB PTR
	RET		;EXIT


;+
; *** PVREC *** "PUT VARIABLE LENGTH RECORD" ROUTINE
;
;  PVREC IS USED TO PUT A VARIABLE LENGTH RECORD INTO A
;  SYSTEM STANDARD 'VARIABLE LENGTH RECORD, SEQUENTIAL' FILE.
;  WITHIN THE FILE, EACH RECORD CONSISTS OF A TWO BYTE BYTE
;  COUNT, LOW BYTE FIRST, FOLLOWED BY THAT NUMBER OF DATA
;  BYTES.
;
; INPUTS:  HL => FPB
;	   BC => RECORD BUFFER
;	   DE = RECORD LENGTH (BYTES)
;
; OUTPUTS: HL => FPB
;	   BC => PAST LAST BYTE IN RECORD BUFFER
;	   DE = 0 IF NO ERRORS
;	   A - LOST
;
; STATUS: <NC> - NO ERRORS
;	   <C><Z> - TRANSFER TERMINATED BY END OF FILE - FILE FULL
;	   <C><NZ><M> - WRITE ERROR
;-

PVREC:	MOV	A,E
	CALL	PTBYT	;PUT LOBYTE OF BYTE COUNT
	RC		;ERROR OR EOF
	MOV	A,D
	CALL	PTBYT	;PUT HIBYTE OF BYTE COUNT
	RC		;ERROR OF EOF
; FALL INTO PTREC


;+
; *** PTREC *** "PUT UNFORMATTED RECORD" ROUTINE
;
;  PTREC IS USED TO PUT AN 'UNFORMATTED' RECORD INTO A
;  SEQUENTIAL FILE. OPERATION OF PTREC IS IDENTICAL TO
;  PVREC, ABOVE, EXCEPT THAT THE TWO BYTE BYTE COUNT
;  IS NOT WRITTEN INTO THE FILE.
;-

PTREC:	LDAX	B	;GET NEXT BYTE
	CALL	PTBYT	;PUT THE BYTE
	RC		;ERROR OR EOF
	INX	B
	DCX	D	;COUNT THE BYTE
	MOV	A,D
	ORA	E	;RECORD ALL DONE ?
	JNZ	PTREC	;NO: PUT ANOTHER BYTE
	RET		;<NC>: NO ERRORS


;+
; * BCHK *
;-

BCHK:	PUSH	D
	PUSH	B
	LXI	D,FAUX-FPB
	DAD	D	;POINT TO AUX. BYTE COUNT
	MOV	E,M	;GET IT ...
	INX	H
	MOV	D,M
	LXI	B,FPTR-FAUX-1
	DAD	B	;POINT TO RELATIVE BUFFER POINTER
	PUSH	H	;SAVE POINTER TO FPTR
	MOV	A,M	;GET IT ...
	INX	H
	MOV	H,M
	MOV	L,A
	XCHG
	CALL	CMPDH	;NEED TO DO A TRANSFER ?
	POP	H	;GET POINTER TO FPTR
	JNC	BCHK1	;<NC>: NEED A TRANSFER
	INX	D	;INCREMENT RELATIVE BUFFER POINTER
	MOV	M,E	;SAVE UPDATED PTR ...
	INX	H
	MOV	M,D
	DCX	D	;RESTORE RELATIVE BUFFER POINTER
	LXI	B,FBUF-FPTR-1
	DAD	B	;POINT TO BUFFER PTR
	MOV	A,M	;GET IT ...
	INX	H
	MOV	H,M
	MOV	L,A
	DAD	D	;INDEX INTO BUFFER
	STC		;<C>: NO TRANSFER NEEDED
BCHK1:	POP	B
	POP	D
	RET		;<C>: NO TRANSFER , <NC>: TRANSFER

; FCS COMMAND INPUT ROUTINE



ESCG:	MVI	M,13	;SETUP INPUT FLAG
	MOV	A,L
	LXI	H,LOFL	;SET UP FCS OUTPUT TO PORT
	MVI	M,14
	JMP	ESCDG	;CONTINUE WITH COMMON

ESCD:	MVI	M,13	;SETUP INPUT FLAG
	MOV	A,L
	LXI	H,LOFL	;SET UP FCS OUTPUT FLAG
	MVI	M,0	;TO BE CRT
ESCDG:	CPI	KBDFL AND 255
	LXI	H,FCSFL	;SET UP FCS ECHO FLAG
	MVI	M,0	;SET FOR ECHO TO SCREEN
	JZ	L1	;YES KEYBOARD
	CPI	BASFL AND 255
	MVI	M,12	;DON'T ECHO IF BASIC INPUT
	JZ	L1	;YES BASIC
	MVI	M,14	;ECHO TO OUTPUT PORT
	LXI	H,LOFL	;SET LO TO OUTPUT PORT
	MVI	M,14
L1:	LXI	H,BUFP	;SET BUFFER PNTR
	SHLD	TEMP4	;SAVE IT
	CALL	RESET	;
	MVI	A,11
	LXI	H,PRMPT	;POINT TO PROMPT
L2:	CALL	FCSOUT
	MOV	A,M
	ANA	A
	RZ		;FINISHED WITH PROMPT
	INX	H
	JMP	L2	;LOOP

FCSX:	MOV	A,E	;GET CHARACTER
	CPI	27	;IS IT ESCAPE ?
	JZ	EFCS	;YES
	CPI	127	;RUB OUT ?
	JZ	L4	;YES
	CPI	32	;CONTROL CHARACTER ?
	JC	L3	;YES
	SUI	255	;IS IT BASIC EXIT ?
	JZ	EFCS	;YES, EXIT
	LHLD	TEMP4
	MVI	A,(BUFP AND 255)+58
	CMP	L	;BUFFER FULL ?
	MVI	A,7
	JZ	FCSOUT	;YES: BEEP
	MOV	M,E	;STORE CHARACTER IN BUFFER
	INX	H	;BUMP POINTER
	SHLD	TEMP4	;SAVE BUFFER PNTR
	MOV	A,E	;GET CHAR.
	JMP	FCSOUT	;GO ECHO IT
L3:	CPI	11	;ERASE LINE ?
	JZ	L1	;YES
	CPI	26	;CURSOR LEFT ?
	JNZ	ELIN	;NO: TERMINATE THE LINE
L4:	LHLD	TEMP4
	MVI	A,BUFP AND 255
	CMP	L	;BUFFER EMPTY ?
	JZ	L1	;YES: ERASE LINE
	DCX	H	;BUMP PNTR BACK
	SHLD	TEMP4	;SAVE BUFFER PNTR
	CALL	L5	;PRINT CURSOR LEFT
	MVI	A,32	;SPACE
	CALL	FCSOUT	;PRINT IT
L5:	MVI	A,26	;CURSOR LEFT
	JMP	FCSOUT	;PRINT IT & RETURN

ELIN:	CALL	FCSOUT	;ECHO
	MVI	A,10
	CALL	FCSOUT
	MOV	A,M
	PUSH	PSW
	MVI	M,0
	SHLD	TEMPHL
	LHLD	TEMP4
	MVI	M,0
	LXI	H,BUFP	;SET BUFFER PNTR
	MOV	A,M
	ANA	A	;EMPTY ?
	CNZ	FCSEM	;NO: GO TO FCS
	LHLD	TEMPHL
	POP	PSW
	MOV	M,A
	JMP	L1

EFCS:	MOV	M,A	;SETUP INPUT FLAG
	LXI	H,LOFL	;CLEAR LO FLAG
	MVI	M,0
	RET

FCSOUT:	PUSH	H	;SAVE MEMORY POINTER
	LXI	H,FCSFL	;SETUP FOR FCS OUTPUT
	CALL	PROCES	;ECHO CHAR IN A REG.
	POP	H	;RESTORE MEMORY POINTER
	RET

PRMPT:	DB 6,3,'FCS>',6,2,0


; UTILITY SUBROUTINES - VERSION 4.0
;

SSIDA	EQU	08H
SSOBE	EQU	10H


CRLF:	MVI	A,13	;ASCII CR
	CALL	LO
	MVI	A,10	;ASCII LF

LO:	CALL	SAVE	;SAVE ALL REGS.
	LXI	H,LOFL
	JMP	PROCES

LBYT:	PUSH	PSW	;SAVE BYTE
	RRC
	RRC
	RRC
	RRC
	CALL	LHXD	;LIST 1ST HEX DIGIT
	POP	PSW	;RETRIEVE BYTE
LHXD:	CALL	B2HEX	;CONVERT VALUE TO HEX DIGIT
	JMP	LO	;LIST DIGIT AND RETURN

B2HEX:	ANI	0FH	;CLEANSE VALUE
	ADI	90H
	DAA
	ACI	40H
	DAA
	RET		;RETURN: A=ASCII HEX DIGIT

NIBL:	SUI	'0'
	RC		;NOT HEX: RETURN <C>
	CPI	10
	CMC
	RNC		;VALID: RETURN <NC>
	CPI	'A'-'0'
	RC		;NOT HEX: RETURN <C>
	SUI	'A'-'9'-1
	CPI	16
	CMC
	RET		;HEX: <NC>, NOT HEX: <C>

S1OUT:	IN	STAT5	;GET STATUS
	ANI	SSOBE	;CAN WE SEND ?
	JZ	S1OUT	;NO: WAIT
	IN	EXTIN	;IS CLEAR TO SEND HI ?
	ANI	80H
	JZ	S1OUT
	MOV	A,E	;GET CHARACTER TO SEND
	OUT	TXBUF	;SEND THE CHARACTER
	RET		;RETURN

RTST:	PUSH	H
	PUSH	D
	PUSH	B
RTST2:	LDA	READY
	CPI	50H
	JZ	RTST2
	CPI	80H
	LDA	KBCHA
	POP	B
	POP	D
	POP	H
	RET


; SEND A MESSAGE STRING TO "LO" DEVICE. BYTE VALUE OF
; 239 DECIMAL TERMINATES THE STRING.
; ALSO SUPPORTS REPEAT LOOPS OF THE FORM :
;    ...,237,N,D1,D2,...,DM,238,...
; WHERE N IS THE REPEAT COUNT FOR THE STRING OF
; BYTES: D1,D2,...,DM .

BSTR:	MOV	A,M
	INX	H
	CPI	239
	RZ
	CALL	CRTUBE
	JMP	BSTR

OSTR:	MOV	A,M	;GET NEXT BYTE
	INX	H
	CPI	237	;SPECIAL CODE ?
	JC	OSTR1	;A<237: GO SEND BYTE
	JZ	OSTR2	;A=237: START REPEAT LOOP
	CPI	239	;SPECIAL CODE ?
	RZ		;A=239: END: RETURN
	JC	OSTR4	;A=238: END OF REPEAT LOOP
OSTR1:	CALL	LO	;SEND BYTE
	JMP	OSTR	;GET NEXT BYTE
OSTR2:	MOV	D,M	;GET REPEAT COUNT
	INX	H
OSTR3:	PUSH	H	;SAVE START POINTER
	JMP	OSTR	;GET NEXT BYTE
OSTR4:	DCR	D	;FINISHED REPEAT ?
	JZ	OSTR5	;YES
	POP	H	;RESTORE START POINTER
	JMP	OSTR3	;REPEAT AGAIN
OSTR5:	POP	PSW	;CLEAN THE STACK
	JMP	OSTR	;GET NEXT BYTE


; SHORT WAIT: 0.5 MS. / COUNT :

;STIM	EQU	50	;FOR 'WAIT' STATE IN ROM
STIM	EQU	63	;FOR NO 'WAIT' STATE IN ROM

WATS:	PUSH	PSW
	MVI	A,STIM
WS1:	DCR	A
	JNZ	WS1
	POP	PSW
	DCR	A
	JNZ	WATS
	RET


; LONG WAIT: 20 MS. / COUNT :

;LTIM	EQU	2347	;FOR 'WAIT' STATE IN ROM
LTIM	EQU	2906	;FOR NO 'WAIT' STATE IN ROM

WATL:	PUSH	H
WL1:	LXI	H,LTIM
WL2:	DCR	L
	JNZ	WL2
	DCR	H
	JNZ	WL2
	DCR	A
	JNZ	WL1
	POP	H
	RET


MOVDH:	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	MOVDH
	RET

MOVHD:	LDAX	D
	MOV	M,A
	INX	D
	INX	H
	DCR	B
	JNZ	MOVHD
	RET

CMPHD:	MOV	A,H
	CMP	D
	RNZ
	MOV	A,L
	CMP	E
	RET

CMPDH:	MOV	A,D
	CMP	H
	RNZ
	MOV	A,E
	CMP	L
	RET

SUBHD:	MOV	A,L
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	RET

SPNOR:	MOV	A,M	;GET NEXT CHAR.
	INX	H
	CPI	32	;IS IT A SPACE ?
	JZ	SPNOR	;YES: IGNORE IT
	DCX	H
	ANA	A	;TEST FOR END OF LINE
	RET		;RETURN TO CALLER

LET:	MOV	A,M	;GET CHAR.
	CPI	'Z'+1	;IS IT A LETTER ?
	RNC		;NO
	CPI	'A'	;CHECK OTHER END
	CMC		;SET C CORRECTLY
	RET		;RETURN: C SET IF LETTER

LODG:	CALL	LET	;IS IT A LETTER ?
	RC		;YES: RETURN

DIG:	MOV	A,M	;GET CHAR.
	CPI	'9'+1	;IS IT A DIGIT ?
	RNC		;NO
	CPI	'0'	;CHECK OTHER END
	CMC		;SET C CORRECTLY
	RET		;RETURN: C SET IF DIGIT

LTNOR:	CALL	LET	;IS NEXT CHAR. A LETTER ?
	INX	H
	JC	LTNOR	;YES: IGNORE IT
	DCX	H
	ANA	A	;TEST FOR END OF LINE
	RET		;RETURN

GCMA:	CALL	SPNOR	;GET FIRST NON-SPACE
	SUI	','	;CHECK FOR COMMA
	ANA	A	;CLEAR C-BIT
	RNZ		;NO COMMA: EXIT <NC>
	INX	H	;SKIP OVER COMMA
	CALL	SPNOR	;GET NEXT NON-SPACE
	STC		;INDICATE COMMA SEEN
	RET		;COMMA: EXIT <C>

MSTR:	MOV	C,B	;COPY ORIG. COUNT
MST01:	CALL	LODG	;LETTER OR DIGIT ?
	JNC	MST02	;NO
	STAX	D	;STORE CHAR.
	INX	H
	INX	D
	DCR	B	;ENOUGH ?
	JNZ	MST01	;NO: LOOP
MST02:	MOV	A,C	;GET ORIG. COUNT
	SUB	B	;COMPUTE BYTE COUNT
	PUSH	PSW	;SAVE IT
	MVI	A,32	;SET SPACE
	JMP	MST04
MST03:	STAX	D	;STORE A SPACE
	INX	D
MST04:	DCR	B	;ANY MORE TO DO ?
	JP	MST03	;YES: LOOP
	POP	PSW	;RESTORE BYTE COUNT
	RET		;RETURN

PSPAC:	MVI	A,32	;SET SPACE
	JMP	LO	;PRINT A SPACE

PCOLN:	MVI	A,':'	;SET COLON
	JMP	LO	;PRINT A COLON

PSSTR:	CALL	PSPAC	;PRINT A SPACE
PSTR:	MOV	A,M	;GET NEXT CHARACTER
	INX	H
	CALL	LO	;PRINT IT
	DCR	B	;ENOUGH ?
	JNZ	PSTR	;NO: LOOP
	RET		;RETURN

PSBYT:	CALL	PSPAC	;PRINT A SPACE
PBYT:	MOV	A,M	;GET NEXT BYTE
	INX	H
	JMP	LBYT	;PRINT THE BYTE

P2SNUM:	CALL	PSPAC	;PRINT A SPACE
PSNUM:	CALL	PSPAC	;PRINT A SPACE
PNUM:	MOV	A,M	;GET LOBYTE
	PUSH	PSW	;SAVE LOBYTE
	INX	H
	MOV	A,M	;GET HIBYTE
	INX	H
	CALL	LBYT	;PRINT HIBYTE
	POP	PSW	;GET LOBYTE
	JMP	LBYT	;PRINT LOBYTE

GN1Z:	LXI	D,0	;SET ZERO
GN1D:	CALL	GCMA	;LOOK FOR COMMA
	CMC
	RNC		;NO NUMBER: EXIT <NC>
	CALL	GN2D	;LOOK FOR NUMBER
	RNC		;NO NUMBER: EXIT <NC>
	PUSH	PSW	;SAVE FLAGS
	CALL	GCMA	;LOOK FOR TRAILING COMMA
	POP	PSW	;RESTORE CODES
	RET		;GOT NUMBER: EXIT <C>

GN2Z:	LXI	D,0	;SET ZERO
GN2D:	CALL	SPNOR	;GET 1ST NON-SPACE
	CALL	NIBL	;CHECK IF HEX
	CMC
	RNC		;NO NUMBER: EXIT <NC>
	LXI	D,0	;INITIALIZE NUMBER TO ZERO
G01:	INX	H	;SKIP CHARACTER
	XCHG
	DAD	H	;MULTIPLY ...
	DAD	H	;... BY ...
	DAD	H	;... SIXTEEN ...
	DAD	H
	ORA	L	;MERGE NEW NIBBLE
	MOV	L,A
	XCHG
	MOV	A,M	;GET NEXT CHARACTER
	CALL	NIBL	;CHECK IF HEX
	JNC	G01	;YES: LOOP
	MOV	A,D	;TEST ...
	ORA	E	;... NUMBER
	STC		;INDICATE NUMBER SEEN
	RET		;GOT NUMBER: EXIT <C>


; GENERAL MATH ROUTINES :

ADHLA:	ADD	L
	MOV	L,A
	RNC
	INR	H
	RET

ANHD:	MOV	A,E
	ANA	L
	MOV	L,A
	MOV	A,D
	ANA	H
	MOV	H,A
	RET

NEGH:	DCX	H
NOTH:	MOV	A,L
	CMA
	MOV	L,A
	MOV	A,H
	CMA
	MOV	H,A
	RET

ORHD:	MOV	A,E
	ORA	L
	MOV	L,A
	MOV	A,D
	ORA	H
	MOV	H,A
	RET

XORHD:	MOV	A,E
	XRA	L
	MOV	L,A
	MOV	A,D
	XRA	H
	MOV	H,A
	RET

SHLHD:	CALL	SCMN
	RZ
SL1:	DAD	H
	DCR	E
	JNZ	SL1
	RET

SHRHD:	CALL	SCMN
	RZ
SR1:	XRA	A
	MOV	A,H
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	DCR	E
	JNZ	SR1
	RET

SCMN:	XCHG
	MVI	A,0F0H
	ANA	E
	ORA	D
	JNZ	ZH
	XRA	E
	RET
ZH:	XRA	A
	MOV	H,A
	MOV	L,A
	RET

MULHD:	PUSH	B
	MOV	B,H
	MOV	C,L
	LXI	H,0
	MVI	A,16
M1:	PUSH	PSW
	DAD	H
	MOV	A,E
	RAL
	MOV	E,A
	MOV	A,D
	RAL
	MOV	D,A
	JNC	M2
	DAD	B
	JNC	M2
	INX	D
M2:	POP	PSW
	DCR	A
	JNZ	M1
	POP	B
	RET

DIVHD:	PUSH	B
	XCHG
	MOV	B,D
	MOV	C,E
	LXI	D,0
	MVI	A,16
D1:	PUSH	PSW
	DAD	H
	MOV	A,E
	RAL
	MOV	E,A
	MOV	A,D
	RAL
	MOV	D,A
	MOV	A,E
	SUB	C
	MOV	E,A
	MOV	A,D
	SBB	B
	MOV	D,A
	JNC	D2
	XCHG
	DAD	B
	XCHG
	INX	H
D2:	POP	PSW
	DCR	A
	JNZ	D1
	POP	B
	JMP	NOTH


;
; BLOCK STRUCTURED DEVICE HANDLER UTILITY
; SUBROUTINES - VERSION 1.0
;
; COPYRIGHT (C) 1977
; BY INTELLIGENT SYSTEMS CORPORATION
;


; CONSTANTS :

CRTR	EQU	3	;"CHUNK" RETRY COUNT

;+
; BC2BK - CONVERT TOTAL BYTE COUNT TO NUMBER OF
;	  BLOCKS AND LAST BLOCK BYTE COUNT.
; INPUTS  - H&L: TOTAL BYTE COUNT
; OUTPUTS - H&L: NUMBER OF BLOCKS
;	    C  : LAST BLOCK BYTE COUNT
;-

BC2BK:	MOV	A,H
	ORA	L
	JZ	BC01
	DCX	H
	MVI	A,7FH
	ANA	L
	INR	A
BC01:	MOV	C,A
	XRA	A
	DAD	H
	RAL
	MOV	L,H
	MOV	H,A
	INX	H
	RET


;+
; BK2BC - CONVERT NUMBER OF BLOCKS AND LAST BLOCK
;	  BYTE COUNT TO TOTAL BYTE COUNT.
; INPUTS  - H&L: NUMBER OF BLOCKS
;	    C  : LAST BLOCK BYTE COUNT
; OUTPUTS - H&L: TOTAL BYTE COUNT
;-

BK2BC:	DCX	H
	MOV	A,H
	RAR
	MOV	A,L
	RAR
	MOV	B,A
	MVI	A,0
	MOV	H,A
	RAR
	MOV	L,A
	DAD	B
	RET


BSB01:	POP	B	;GET CALLER'S RETURN ADDR.
	PUSH	H	;SAVE PBLK PNTR
	PUSH	D	;SAVE DEVICE NAME
	LXI	D,BS02
	PUSH	D	;SET RETURN ADDRESS
	PUSH	B	;SAVE CALLER'S RETURN ADDR.
	MOV	C,A	;COPY NUMBER OF UNITS
	LXI	D,TFCN	;POINT TO TEMP STORAGE AREA
	MVI	B,8	;SET COUNT
	CALL	MOVDH	;MOVE PARAMETERS
	POP	H	;GET CALLER'S RETURN ADDR.
	LDA	TDRV	;GET DRIVE NUMBER
	MVI	B,EIVU	;SET ERROR CODE
	CMP	C	;VALID UNIT NUMBER ?
	RNC		;NO: ERROR EXIT
	LDA	TFCN	;GET FUNCTION CODE
	CPI	2	;IS IT VALID ?
	JC	BS01	;YES
	MVI	B,EIVF	;SET ERROR CODE
	CPI	-4	;IS IT VALID ?
	RC		;NO: ERROR EXIT
BS01:	MVI	B,SOK	;SET GOOD STATUS CODE
	ANA	A	;TEST FUNCTION CODE
	PCHL		;RETURN TO CALLER

BS02:	MOV	A,B	;GET STATUS CODE
	ANA	A	;ANY ERRORS ?
	JNZ	HANER	;YES
	POP	D	;DISCARD DEVICE NAME
	POP	D	;DISCARD PBLK PNTR
	LHLD	TBLK	;GET BLOCK NUMBER
	RET		;EXIT
HANER:	LXI	H,ERS1
	CALL	OSTR	;PRINT ERROR STRING
	LXI	H,ERS2-3
	MOV	C,B	;COPY ERROR CODE
	MVI	B,0
	DAD	B	;POINT TO ERROR STRING
	MVI	B,3	;SET COUNT
	CALL	PSTR	;PRINT 3 ERROR CHARACTERS
	LXI	H,0
	DAD	SP	;POINT TO DEV. NAME ON STACK
	MVI	B,2	;SET COUNT
	CALL	PSSTR	;PRINT DEVICE NAME
	POP	H	;DISCARD DEVICE NAME
	POP	H	;GET PBLK PNTR
	MOV	B,M	;GET FUNCTION CODE
	INX	H
	MOV	A,M	;GET UNIT NUMBER
	CALL	LBYT	;PRINT UNIT NUMBER
	CALL	PCOLN	;PRINT A COLON
	MOV	A,B	;GET FUNCTION CODE
	CALL	LBYT	;PRINT FUNCTION CODE
	LXI	H,TBLK	;POINT TO BLOCK NUMBER
	CALL	PSNUM	;PRINT BLOCK NUMBER
	CALL	CRLF	;PRINT CR & LF
	STC		;INDICATE ERROR
	RET		;EXIT

ERS1:	DB 255,6,1,11,'E',239
SOK	EQU	0	;"GOOD" STATUS CODE
ERS2:	DB 'IVF'
EIVF	EQU	$-ERS2
	DB 'IVU'
EIVU	EQU	$-ERS2
	DB 'BLK'
EBLK	EQU	$-ERS2
	DB 'SKF'
ESKF	EQU	$-ERS2
	DB 'CFB'
ECFB	EQU	$-ERS2
	DB 'DSY'
EDSY	EQU	$-ERS2
	DB 'DCS'
EDCS	EQU	$-ERS2
	DB 'MEM'
EMEM	EQU	$-ERS2
	DB 'VFY'
EVFY	EQU	$-ERS2


BSB08:	LDA	TFCN	;GET FUNCTION CODE
	DCR	A	;TEST IT
	ANA	A	;CLEAR C STATUS BIT
	RM		;READ: RETURN
	JZ	BS04	;WRITE: PROCESS
	STA	TFCN	;WAS VERIFY: SET WRITE
	RET		;RETURN
BS04:	LHLD	TBC	;GET CURRENT BYTE COUNT
	XCHG
	LHLD	OBC	;GET OLD BYTE COUNT
	SHLD	TBC	;RESET BYTE COUNT TO OLD VALUE
	CALL	SUBHD	;COMPUTE DIFFERENCE
	XCHG
	LHLD	TMEM	;GET CURRENT MEMORY PNTR
	CALL	SUBHD	;ADJUST IT
	SHLD	TMEM	;RESET MEM PNTR TO OLD VALUE
	XCHG
	CALL	BC2BK	;CONVERT TO NUMBER OF BLOCKS
	XCHG
	LHLD	TBLK	;GET CURRENT BLOCK NUMBER
	CALL	SUBHD	;ADJUST IT
	SHLD	TBLK	;RESET BLK NUMBER TO OLD VALUE
	MVI	A,2	;SET VERIFY FUNCTION CODE
	STA	TFCN	;STORE IT
	STC		;INDICATE "RESET"
	RET		;RETURN

	TBADDR	EQU	$	;SETUP FOR CONTINUATION



	;32 LINES BY 64 CHARACTERS

	;COMPUCOLOR II SOFTWARE VER 9.78

	;COPYRIGHT (C) 1974,1975,1976,1977,1978
	;BY COMPUCOLOR CORP.
	;PROGRAMMED BY CHARLES A MUENCH

	;8080 CPU CLOCK=17.9712/9=1.9968 MHZ
	;MIN TIME INTERVAL=16X.5008=8.0128 US
	;MIN COUNT FOR INTERVAL TIMERS=64.1 US
	;15.6 COUNTS=1 MS
	;78 COUNTS=5 MS
	;156 COUNTS=10 MS
	;195 COUNTS=12.5 MS
	;255 COUNTS =16.346 MS
	;195 COUNTS X 8 =100 MS
	;	    X 40 =.5 SEC.
	;	    X 80 = 1 SEC.
	;	    X 160 = 2 SEC.
	;	    X 240 = 3 SEC.

NOLIN	EQU	32
NOCHA	EQU	64
MFIOA	EQU	0
RXBUF	EQU	MFIOA
EXTIN	EQU	MFIOA+1
RSTBF	EQU	MFIOA+2
STAT5	EQU	MFIOA+3
COMND	EQU	MFIOA+4
BAUD	EQU	MFIOA+5
TXBUF	EQU	MFIOA+6
EXTOT	EQU	MFIOA+7
MASK	EQU	MFIOA+8
TIME1	EQU	MFIOA+9
TIME2	EQU	MFIOA+10
TIME3	EQU	MFIOA+11
TIME4	EQU	MFIOA+12
TIME5	EQU	MFIOA+13
FPROM	EQU	80H
PRM0	EQU	FPROM+0
PRM1	EQU	FPROM+1
PRM2	EQU	FPROM+2
PRM3	EQU	FPROM+3
PRM4	EQU	FPROM+4
PRM5	EQU	FPROM+5
PRM6	EQU	FPROM+6
CRTCHIP	EQU	60H
CRT0	EQU	CRTCHIP+0
CRT1	EQU	CRTCHIP+1
CRT2	EQU	CRTCHIP+2
CRT3	EQU	CRTCHIP+3
CRT4	EQU	CRTCHIP+4
CRT5	EQU	CRTCHIP+5
CRT6	EQU	CRTCHIP+6
ROLDA	EQU	CRT6
CRXDA	EQU	CRTCHIP+12
CRYDA	EQU	CRTCHIP+13
STOPIT	EQU	CRTCHIP+10
STARTIT	EQU	CRTCHIP+14

BASICW	EQU	0040H
BASICE	EQU	0046H
BASICI	EQU	0052H
BASEX	EQU	0055H
AUTOX	EQU	0058H


	ORG	CRTRAM

XOUT0:	DS	1	;CHEAP DISK USER
XOUT1:	DS	1
CTRK0:	DS	1
CTRK1:	DS	1
AUCNT:	DS	1
BUCNT:	DS	1
CUCNT0:	DS	1
CUCNT1:	DS	1
PUP:	DS	1	;POWER UP FLAG
HEX:	DS	1	;BINARY FRACTIONS OF A SECOND
	DS	1	;SECONDS
	DS	1	;MINUTES
	DS	1	;HOURS (24)
DISPCK:	DS	3	;JMP TO DISPLAY CLOCK
ESCCRT:	DS	3	;CRT ESCAPE 30 JUMP
OUTCRT:	DS	3
INPCRT:	DS	3	;FREE INPUT TABLE JMP
RST1J:	DS	3	;TIMER 2 JMP VECTOR

;		RAM IS CLEARED FROM HERE TO END (8200H)

VCRAD:	DS	2
ROLLN:	DS	1
VFILL:	DS	2
BFILL:	DS	2
VHLAD:	DS	2
BHLAD:	DS	2
EXTBF:	DS	1
SEC15:	DS	1
PCRAD:	DS	2
PLOFL:	DS	1
PSTAT:	DS	1
ROLFL:	DS	1
DUPLX:	DS	1
THRUFL:	DS	1
KBDFL:	DS	1
CMASK:	DS	1	;CURRENT MASK REGISTER SETTING
FCSFL:	DS	1	;FILE CONTROL SYSTEM OUTPUT FLAG
CRATE:	DS	1	;CURRENT BAUD RATE SETTING
INPFL:	DS	1
LKC:	DS	1
NKC:	DS	1
COLFL:	DS	1
JUMP:	DS	3
XTWO:	DS	1
YTWO:	DS	1
XDATA:	DS	1
YDATA:	DS	1
ODDFL:	DS	1
XZERO:	DS	1
YZERO:	DS	1
BASFL:	DS	1
TEMP0:	DS	1
TEMP1:	DS	1
TEMP2:	DS	1
TEMP3:	DS	1
TEMP4:	DS	1
TEMP5:	DS	1
OUTFL:	DS	1
LOFL:	DS	2
OUTHL:	DS	2
MS150:	DS	1
KBCHA:	DS	1
READY:	DS	1


	ORG	0
TIMX1:
START:	JMP	STARX
INITAD:	DW	BASICI	;BASIC INITIAL ADDRESS
TAU:	DB	15	;TIME BASE FOR 8/15 SECONDS
MODE:	DB	0
PROLL:	DB	1	;0=PAGE   1=ROLL

	ORG	8
TIMX2:	JMP	RST1J
AESCTB:	DW	ESCTB	;ADDRESS OF ESCAPE TABLE
CARET:	DB	0DH
CHDEL:	DB	-80
DELTA:	DB	8	;NUMERATOR FOR 8/15 SECONDS

	ORG	10H
XINTR:	JMP	UPDATE	;CLOCK UPDATE
	DS	3
RATEA:	DB	0C0H	;9600BAUD+1 STOP
RCOMD:	DB	08H	;BAUD  1X=08H    8X=18H

	ORG	18H
TIMX3:	JMP	TIM3X
TPROG:	DB	-12	;150MS
CHTIM:	DB	5
KEDEL:	DB	255
KERDY:	DW	READY

	ORG	20H
RXSER:	JMP	ISERL
	DB	64	;NUMBER OF CHARACTERS
KEYTEST:JMP	RTST
STEPCD:	DB	STPTIM	;CHEAP DISK STEP RATE

	ORG	28H
TXSER:	JMP	OSERL
KEYCO:	JMP	KBREP	;PROCESS KEY CODE
CDMK:	DB	4	;4 FOR PROPER CLOCK OPERATION
RATEB:	DB	0A0H	;4800 BAUD +1 STOP BIT

	ORG	30H
TIMX4:	JMP	TIM4X
BASOUT:	JMP	CRTUBE	;PROCESS CHAR WITH BASIC FLAG
ACRTSP:	DW	STACK	;ADDRESS OF TOP OF STACK FOR CRT MODE


	ORG	38H
TIMX5:
BEGEX:	JMP	BEGIN
BREAK:	JMP	BRAKE	;PROCESS BREAK CODE
KCHAR:	DW	KBCHA

	ORG	TBADDR

;	DISK HANDLER VALUES AND VECTORS

IDEV:	DB	'CD'	;INITIAL DEFAULT DEVICE
IUNT:	DB	'0'	;INITIAL DEFAULT UNIT

HDVCT:	JMP	CDHD	;JMP TO HANDLER
CDNM:	DB	'CD'	;DEVICE NAME
CDNU:	DB	2	;NUMBER OF UNITS
CDSEC:	DB	NSEC
CDK:	DB	UPTIM/STPTIM
	DS	2

	DB	255
	DS	9

	DB	255
	DS	5



TBL00:	DW	FREE,AUTOX    ;@,A 0,1
	DW	POTON,CRSXY  ;B,C 2,3
	DW	FREE,FREE    ;D,E/4,5
	DW	CCI,BEL	     ;F,G/6,7
	DW	HOME,TAB     ;H,I/8,9
	DW	LF,ELINE     ;J,K/10,11
	DW	ERASE,CR     ;L,M/12,13
	DW	A7ON,BA7OF   ;N,O/14,15
TBL24:	DW	PRINT,CRSRT  ;X,Y/24,25
	DW	CRSLT,ESCAP ;Z,ESC/26,27
	DW	CRSUP,COMOF  ;\,]/28,29
	DW	COMON,BLINK  ;^,_/

ESCTB:	DW	FREE,BLIND	;@,A / 0,1
	DW	CHPLO,TXPEN	;B,C / 2,3
	DW	ESCD,BASICE	;D,E / 4,5
	DW	FULL,ESCG	;F,G / 6,7
	DW	HALF,9000H	;H,I / 8,9
	DW	DOWN,ROLL	;J,K / 10,11
	DW	LOCLX,TMODE	;L,M / 12,13
	DW	TMODE,FREE	;N,O / 14,15
	DW	FREE,FREE	;P,Q / 16,17
	DW	BRATE,0A000H	;R,S / 18,19
	DW	8200H,FREE	;T,U / 20,21
	DW	FREE,BASICW	;V,W / 22,23
	DW	PAGER,TEST	;X,Y / 24,25
	DW	FREE,VISIB	;Z,[ / 26,27
	DW	FREE,FREE	;\,] / 28,29
	DW	ESCCRT,CRTMO	;^,_ / 30,31

OUTBL:	DW	BEGOT,KEYOT	;0,1
	DW	LTPEN,XYMIT	;2,3
	DW	LINE,CARR	;4,5
	DW	OUTCRT,CRET	;6,7


INPTB:	DW	SVCHA,SBCHA	;0,1
	DW	PLOTX,CURSO	;2,3
	DW	CPLOX,VCRSY	;4,5
	DW	CCIX,BCRSX	;6,7
	DW	BCRSY,BCCIX	;8,9
	DW	INPCRT,INPCRT	;10,11
	DW	FREEX,FCSX	;12,13
	DW	S1OUT,INPCRT	;14,15
	DW	INPCRT,INPCRT	;16,17
	DW	BRATX,INPCRT	;18,19
	DW	INPCRT,INPCRT	;20,21
	DW	INPCRT,BASEX	;22,23
	DW	INPCRT,TESTX	;24,25
	DW	INPCRT,ESCAX	;26,27
	DW	INPCRT,INPCRT	;28,29
	DW	INPCRT,INPCRT	;30,31


	;BEGEX LOOP TIME ,NO WAIT = 33 US
	;WITH PROM WAIT = 40.5 US

BEGIN:	EI
	JMP	BEGEX

STARX:	LXI	D,BEGEX	;SET RETURN ON STACK
	LHLD	ACRTSP	;SET UP STACK ADRESS
	SPHL
	PUSH	D
	OUT	STOPIT	;RESET CRT CHIP
	IN	PRM0	;COPY PROM PARAMETERS
	OUT	CRT0	;INTO CRT REGISTERS
	IN	PRM1
	OUT	CRT1
	IN	PRM2
	OUT	CRT2
	IN	PRM3
	OUT	CRT3
	IN	PRM4
	OUT	CRT4
	IN	PRM5
	OUT	CRT5
	IN	PRM6
	OUT	CRT6
	OUT	STARTIT	;RESTART CRT CHIP
	MVI	A,3
	OUT	COMND	;RESET MFIOA
	LDA	PUP	;IS THIS REAL POWERUP ?
	CPI	97H
	JNZ	PWRUP	;YES
	MVI	A,080H	;IS THIS USER RESET (COMMAND) ?
	OUT	EXTOT
	IN	EXTIN
	ANI	30H
	LHLD	OUTBL-2	;SETUP CRTMODE AS EXIT POINT
	JNZ	CRTSET	;NO RESET TO CRT MODE
	JMP	INIBAS	;YES, INITIALIZE BASIC ONLY
PWRUP:	LXI	H,HEX
	MVI	B,4
	MVI	M,0
	INX	H
	DCR	B
	JNZ	$-4
INIBAS:	LHLD	INITAD
CRTSET:	PUSH	H	;SAVE EXIT POINT
	LXI	H,VCRAD
	XRA	A
	MOV	M,A
	INR	L
	JNZ	$-2
	MVI	L,JUMP AND 255
	MVI	M,0C3H
	MVI	L,VFILL+1 AND 255
	MVI	M,7
	MVI	L,BFILL+1 AND 255
	INR	M
	LDA	PROLL
	CALL	PAGER
	CALL	ERASE
	CALL	TIM4Y
	LDA	RATEA
	OUT	BAUD
	STA	CRATE
	OUT	TIME3
	LDA	MODE
	STA	DUPLX
	CALL	BEGOT
	CALL	RESET
	RET		;JUMP TO ENTRY POINT

	LHLD	VFILL
	XCHG
GETBC:	LHLD	VCRAD
	MOV	C,L
	MOV	B,H
	LHLD	VHLAD
	RET

UPDATE:	CALL	SAVE	;INTERUPT ROUTINE
	LXI	H,HEX	;UPDATE FRACTION
	LDA	DELTA
	MOV	B,A
	LDA	TAU
	MOV	C,A
	MOV	A,M	;SUBTRACT DELTA
	SUB	B
	MOV	M,A	;STORE NEW FRACTION
	RNC		;RETURN IF NO CARRY
	ADD	C	;ADD TAU
	MOV	M,A	;REPLACE NEW FRACTION
	INX	H	;POINT AT SECONDS
	INR	M	;INCREMENT SECONDS
	MOV	A,M	;AND LOAD THEM
	SUI	60	;COMPARE TO 60
	RC		;SECONDS ARE GOOD : EXIT
	MOV	M,A	;MAPS 60 TO 0
	INX	H	;POINT AT MINUTES
	INR	M	;INCREMENT MINUTES
	MOV	A,M	;AND LOAD THEM
	SUI	60	;COMPARE TO 60
	RC		;MINUTES ARE GOOD : EXIT
	MOV	M,A	;MAPS 60 TO 0
	INX	H	;POINT AT HOURS
	INR	M	;INCREMENT HOURS
	MOV	A,M	;AND LOAD THEM
	CPI	25	;COMPARE TO 25
	RC		;HOURS ARE GOOD : EXIT
	SUI	24
	MOV	M,A	;MAPS 25 TO 1
	RET		;FIX HOURS AND EXIT ANYWAY

TESTX:	MOV	M,A
	MOV	A,E
	JMP	EARS+2
ERASE:	CALL	NOROL
EARS:	MVI	A,20H	;SPACE
	LXI	H,X80
	MVI	B,0	;NOLIN*NOCHA/8
	PUSH	H
	LHLD	VFILL
	XCHG
	ORA	E
	MOV	E,A
	LXI	H,0
	DAD	SP
	SHLD	TEMP0
	POP	H
	DI
	SPHL
ERALP:	PUSH	D
	PUSH	D
	PUSH	D
	PUSH	D
	PUSH	D
	PUSH	D
	PUSH	D
	PUSH	D
	DCR	B
	JNZ	ERALP
	LHLD	TEMP0
	SPHL
	EI
	POP	H
	RET
NOROL:	LXI	H,X80
	SHLD	BHLAD
	XRA	A
	STA	ROLLN
HOME:	LXI	H,ROLLN
	MOV	B,M
CR:	MOV	C,A
SVCRS:	CALL	LN5X
	SHLD	VHLAD
	LXI	H,VCRAD
	MOV	M,C
	INX	H
	MOV	M,B
	INX	H
	MOV	A,M
	DCR	A
	ANI	31
	OUT	ROLDA
	MOV	A,B
	OUT	CRYDA
	MOV	A,C
	OUT	CRXDA
	RET
CRSY:	CALL	TESTB-2
	LDA	ROLLN
	ADD	B
	CALL	TESTB
LN5X:	LDA	VFILL
	RLC
	ORA	B
	MOV	B,A
	MOV	A,B
LN5Y:	RLC
	RLC
	;	ADD	B	;A=5B
	LXI	H,X80/(32)
	ADD	L
	MOV	L,A
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	MOV	A,C
	RLC
	ADD	L
	MOV	L,A
	RNC
	INR	H
	RET
TAB:	MVI	A,7
	ORA	C
	MOV	C,A
CRSRT:	INR	C
	MVI	A,-NOCHA
	ADD	C
	JNC	SVCRS
	MOV	C,A
LF:	INR	B
	CALL	TESTB+1
IROLL:	LDA	ROLFL
	ANA	A
	JZ	SVCRS
	LXI	H,ROLLN
	MOV	A,B
	XRA	M
	JNZ	SVCRS
	INR	M
	INR	M
	MVI	A,-NOLIN
	CALL	TESTC+6
	INX	H
	MOV	C,M
	PUSH	B
	XRA	A
	MOV	M,A
	CALL	EARLN
	LXI	B,NOCHA*2
	CALL	EARLN+9
	POP	PSW
	MOV	B,A
	RP
A7ON:	LXI	H,VFILL
	MVI	M,80H
	JMP	SVCRS
CRSLT:	DCR	C
	JP	SVCRS
	MVI	C,NOCHA-1
CRSUP:	LDA	VFILL
	ANA	A
	JP	$+4
	DCR	B
	DCR	B
	JP	SVCRS
	MVI	B,NOLIN-1
	JMP	SVCRS
COLOR:	XTHL
	CALL	GETBC
	MOV	E,A
	LXI	H,TBL00
	CPI	16
	JC	CODE
	CPI	24
	LXI	H,TBL24-48
	JNC	CODE
	POP	H
	MVI	L,COLFL AND 255
	CALL	COLW
	JZ	BKCOL
	MVI	A,0F8H
	MOV	D,B
BKCOL:	ANA	M
	ORA	D
	MOV	M,A
	RET
COLW:	ANI	7
	MOV	B,A
	RLC
	RLC
	RLC
	MOV	D,A
	MOV	L,M
	DCR	L
	MVI	L,VFILL+1 AND 255
	MVI	A,0C7H
	RET
COMON:	INR	A
COMOF:	MVI	L,COLFL AND 0FFH
	MOV	M,A
	RET
BLINK:	MVI	A,40H
	MVI	L,VFILL+1 AND 255
	ORA	M
	MOV	M,A
	RET
BA7OF:	MVI	L,VFILL AND 255
	MOV	M,A
	MVI	A,0BFH
	INR	L
	ANA	M
	MOV	M,A
	RET

KBREP:	MOV	E,A	;PUT CHAR IN E
	LDA	DUPLX
	ANA	A	;LOCAL=0
	MVI	A,0DFH	;T5,T4,-,RX,T3,RTC,T2,T1
	LXI	H,OUTFL
	JZ	$+7	;HALF=1
	MVI	M,1
	MVI	A,0F7H	;T5,T4,TX,RX,-,RTC,T2,T1
	OUT	MASK
	STA	CMASK	;SAVE CURRENT MASK SETTING
	MVI	L,KBDFL AND 255
	RM		;FULL=-1
	JMP	ISERX

CRTUBE:	CALL	SAVE	;SAVE ALL REGS.
	LXI	H,BASFL
	JMP	PROCES

	;ISERL TO INPTB TIME = 103 US, NO WAIT
	;WITH PROM WAIT = 122.5 US

ISERL:	CALL	SAVE	;SAVE ALL REGISTERS
	LXI	H,READY
	MVI	M,50H
	IN	STAT5
	ANI	1
	RNZ
	MVI	M,80H
	DCX	H
	IN	RXBUF
	MOV	M,A
	IN	RXBUF
	LXI	H,INPFL
PROCES:	MOV	E,A
	MVI	A,1
	OUT	EXTOT
ISERX:	MOV	A,M
	PUSH	H
	LXI	H,INPTB
CODE:	RLC
	ADD	L
	MOV	L,A
	MOV	A,H
	ACI	0
	MOV	H,A
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A
	XTHL
CODE2:	LDA	EXTBF
	OUT	EXTOT
	XRA	A
	RET

ZERFL:	MOV	A,E
	ANI	7FH
	CPI	32
	JC	COLOR
	CPI	96
	RC
SP64C:	MVI	L,COLFL AND 255
	MOV	L,M
	DCR	L
	RNZ
	SUI	96
	RET

	;SBCHA NO 2X CHA = 84 US ,NO WAIT
	;SBCHA WITH SP64 CHA ADD 18 US ,NO WAIT

SBCHA:	CALL	ZERFL	;34 US MIN
	LHLD	BFILL	;41 US MIN WAIT
	XCHG	;52 US MAX
	LHLD	BHLAD	;63 US MAX WAIT
	ORA	E
	MOV	M,A
	INX	H
	MOV	M,D
	INX	H
	CM	STOR2
TESHI:	MVI	A,(X80+NOLIN*NOCHA*2) SHR 8 
	CMP	H
	SHLD	BHLAD
	RNZ
	LXI	H,X80
	SHLD	BHLAD
	RET

SVCHA:	CALL	ZERFL
	CALL	STOR1-3
	CM	STOR2
	JMP	JUMP
	CALL	GETBC-4
STOR1:	ORA	E
	MOV	M,A
	INX	H
	MOV	M,D
	INX	H
	RET
STOR2:	PUSH	H
	PUSH	B
	LXI	B,-NOCHA*2-2
	DAD	B
	POP	B
	MOV	M,A
	INX	H
	MOV	M,D
	POP	H
	RET

CHPLO:	INR	E
TMODE:	INR	E
	MOV	M,E
	RET

	;CCIX TRICKEY BYTE SAVER

CCIX:	MOV	M,A
	MVI	L,VFILL+1 AND 255
	MVI	B,36H	;TRICK
	LXI	B,0CF2EH	;TRICK
	ORG	$-4

BCCIX:	MVI	M,1
	MVI	L,BFILL+1 AND 255

ESCAP:
BRATE:
BLIND:
CRSXY:
CCI:
TEST:
CHAIN:
	MOV	M,E
FREE:
FREEX:
VISIB:	RET

CURSO:	MOV	A,E
	CPI	81
	MVI	M,7
	JNC	B7ON
	MVI	M,5
	MVI	L,VCRAD AND 255
	MOV	M,A
	RET
B7ON:	ANI	80H
	MVI	L,BFILL AND 255
	MOV	M,A
	RET

VCRSY:	MOV	M,A
	MVI	L,VCRAD AND 255
	MOV	C,M
	MOV	A,E
	CALL	CRSY
	JMP	SVCRS+3
BCRSX:	INR	M
	MVI	L,BHLAD AND 255
TESTC:	MOV	A,E
	ANI	127
	MOV	M,A
	MVI	A,-NOCHA
	ADD	M
	RNC
	MOV	M,A
	RET
BCRSY:	INR	M
	MVI	L,BHLAD AND 255
	MOV	C,M
	MOV	A,E
	CALL	CRSY
	SHLD	BHLAD
	RET

	ANI	31 OR NOLIN
TESTB:	MOV	B,A
	MVI	A,-NOLIN
	ADD	B
	RNC
	MOV	B,A
	RET

HALF:	MVI	A,2
FULL:	DCR	A
LOCLX:	STA	DUPLX
	RET

KEYOT:	MOV	M,A
	LDA	KBCHA
	OUT	TXBUF
BEGOT:	MVI	A,0DFH	;T5,T4,-,RX,T3,RTC,T2,T1
	OUT	MASK
	STA	CMASK	;SAVE	CURRENT	MASK SETTING
	RET
OSERL:	CALL	SAVE	;SAVE ALL REGISTERS
	LXI	H,OUTFL
	PUSH	H
	MOV	A,M
	LXI	H,OUTBL
	JMP	CODE
BRATX:	MOV	M,A
	MVI	A,7
	ANA	E
	RZ
	MOV	E,A
	MVI	A,80H
	RLC
	DCR	E
	JNZ	$-2
	MVI	L,VFILL AND 255
	ORA	M
	OUT	BAUD
	STA	CRATE	;SAVE CURRENT BAUD RATE
	RET

ROLL:	INR	A
PAGER:	LXI	H,CRSRT
	STA	ROLFL
	SHLD	JUMP+1
	RET
DOWN:	LXI	H,LF
	JMP	PAGER+3

PRINT:	MVI	L,OUTFL AND 255
	MVI	M,5
	LXI	H,X80+NOLIN*NOCHA*2-1
	MOV	M,A
	CMA
	DCX	H
	MOV	M,A
	CALL	NROLL
	LHLD	VHLAD
	JMP	TXOUT+2

ESCAX:	MOV	M,A
	MVI	A,31
	PUSH	H
	LXI	H,ESCTB
	ANA	E
	MOV	E,A
	JMP	CODE
BRAKE:	CALL	HALF
	LDA	RCOMD
	ORI	2
	OUT	COMND
	JMP	BEL+5
BEL:	MVI	A,40H
	CALL	TIM4Z
	LDA	TPROG
	STA	MS150
	JMP	TIM4X+7

TIM4X:	CALL	SAVE	;SAVE ALL REGISTERS
	LXI	H,MS150
	INR	M
	JZ	TIM4Y
	MVI	A,195
	OUT	TIME4
	RET
TIM4Y:	LDA	RCOMD
	OUT	COMND
	XRA	A
TIM4Z:	STA	EXTBF
	OUT	EXTOT
	RET

ELINE:	CALL	EARLN
	INR	E
	DCR	E
	LXI	B,-NOCHA*2
	JM	EARLN+9
	RET

EARLN:	CALL	CR
	LHLD	VHLAD
	LXI	B,NOCHA*2-NOCHA*2*NOLIN
	DAD	B
	LXI	B,NOCHA*32
	MVI	A,20H
	JMP	EARS+7

LTPEN:	LHLD	OUTHL
	MVI	A,TEMP5 AND 255
	CMP	L
	JMP	TWOUT

XYMIT:	LHLD	OUTHL
	MOV	A,L
	ANI	127
	JZ	FEED
	XRA	A
TXCONT:	CMP	M
	JNZ	TWOUT
	DCX	H
	CMA
	CMP	M
	INX	H
TWOUT:	MOV	A,M
	INX	H
	INX	H
	JNZ	TXOUT
	LXI	H,OUTFL
	MVI	M,7
TXOUT:	OUT	TXBUF
	MVI	A,0FFH	;T5T4,TX,RX,T3,RTC,T2,T1
	OUT	MASK
	STA	CMASK	;SAVE CURRENT MASK
	SHLD	OUTHL
	RET

FEED:	LXI	H,OUTFL
	MVI	A,10	;LINEFEED
	JMP	LINE+2
LINE:	MVI	A,13	;CARRAGE RETURN
	INR	M	;INC FLAG VALUE
	LHLD	OUTHL
	JMP	TXOUT

CARR:	DCR	M
	DCR	M
	LHLD	OUTHL
	JMP	TXCONT

CRET:	MOV	M,A
	LDA	CARET	;CR
	JMP	KEYOT+4

TXPEN:	MOV	M,A
	CALL	GETBC
	MOV	E,M
	INX	H
	MOV	D,M
	LXI	H,OUTFL
	MVI	M,2
	MVI	L,TEMP5 AND 255
	MOV	M,E
	DCR	L
	MOV	M,D
	DCR	L
	MVI	M,6
	DCR	L
	LDA	ROLLN
	CMA
	INR	A
	ADD	B
	JP	$+5
	ADI	NOLIN
	MOV	M,A
	DCR	L
	MOV	M,C
	MVI	A,3
	JMP	TXOUT

SHIFF:	RLC
	JNC	LS2
	MOV	E,A
	INR	L
	MOV	A,L
	CPI	NOCHA*2
	JC	LS1
	XRA	A
	MOV	L,A
LS1:	MOV	A,E
LS2:	RLC
	JNC	LS4
	DCR	L
	INR	L
	JNZ	LS3
	MVI	L,NOCHA*2
LS3:	DCR	L
LS4:	RLC
	JNC	LS6
	DCR	H
	INR	H
	JNZ	LS5
	MVI	H,NOLIN*4
LS5:	DCR	H
LS6:	RLC
	MOV	E,A
	JNC	LS8
	INR	H
	MOV	A,H
	CPI	NOLIN*4
	JC	LS7
	XRA	A
	MOV	H,A
LS7:	MOV	A,E
LS8:	ANI	0F0H
	RET

VECTY:	CALL	INVY-2
	JMP	VECT0
INVEC:	LHLD	XTWO
	CALL	SHIFF
	SHLD	XDATA
	RZ
	MOV	C,L
	MOV	B,H
	LHLD	XZERO
	MOV	A,E
	CALL	SHIFF
	SHLD	XZERO
	RZ
	PUSH	H
	CALL	PUTYD-6
	POP	B
	JMP	VECT0+2

	MVI	L,YZERO AND 255
INVY:	MOV	B,A
	MVI	A,NOLIN*4-1
	SUB	B
	CPI	NOLIN*4
	MOV	M,A
	MOV	B,A
	RC
	ADI	NOLIN*4
	JMP	$-7
PXZER:	MVI	L,XZERO AND 255
	CPI	NOCHA*2
	MOV	M,A
	RC
	SUI	NOCHA*2
	MOV	M,A
	RET
PLPTY:	CALL	INVY
	MVI	E,XYTAB AND 255
	JMP	PUTYD

PBINX:	CALL	INCXY
	JZ	$+9
	CALL	$+6
	CALL	MOVXY
	MOV	A,C
	MVI	H,46H	;TRICK
	ORG	$-1

BARXM:	MOV	B,M
	LXI	H,XZERO
	CMP	M
	JZ	PUTYD-5
	MVI	E,BARTX AND 255
	CALL	PUTYD-3
	MVI	A,0FH
	ANA	E
	RLC
	RLC
	RLC
	RLC
	ORA	E
	MOV	E,A
	MOV	A,C
	RLC
	MOV	C,A
	LDA	XZERO
	MOV	B,A
BXLOP:	XRA	A
	CMP	C
	RZ
	DCR	C
	DCX	H
	MOV	A,C
	CMP	B
	RC
	JZ	PUTXZ
	DCR	C
	CALL	PXYCH
	JMP	BXLOP
BARYM:	CALL	INVY
	LXI	H,YZERO
	XRA	M
	ANI	252
	LDA	XDATA
	JZ	PUTZZ
	MVI	E,BARTY AND 255
	CALL	PUTYD-3
	LDA	YZERO
	ANI	252
	RRC
	RRC
	MOV	C,A	;C=YZERO SHR 2
	MOV	A,E
	RLC
	MVI	E,0FH
	JNC	$+5
	MVI	E,0F0H
BYLOP:	MOV	A,C
	INR	B
	CMP	B
	RC
	CZ	PUTYZ
	MVI	A,NOCHA*2
	ADD	L
	MOV	L,A
	JNC	$+4
	INR	H
	CALL	PXYCH-1
	JMP	BYLOP
PLINC:	CALL	INCXY
	JZ	PUTYD-6
	CALL	PUTYD-6
	CALL	MOVXY
	JMP	PUTYD-6
PBINY:	CALL	INCXY
	JZ	$+9
	CALL	$+6
	CALL	MOVXY
	MOV	A,B
	JMP	BARYM+3
PUTXD:	LXI	H,ODDFL
	CPI	NOCHA*2
	JC	$+5
	SUI	NOCHA*2
	MOV	C,A
	ANI	1	;ODD=1
	MOV	M,A	;ODDFL
	MVI	L,XDATA AND 255
	MOV	M,C
	MOV	A,C
	RAR
	MVI	L,PCRAD AND 255
	MOV	M,A
	RET
PLOTX:	MOV	A,E
	XRI	255
	JNZ	$+12
	MOV	M,A
	MVI	L,VFILL+1 AND 255
	MVI	A,7FH
	ANA	M
	JMP	NROLL-1
	MVI	L,PLOFL AND 255
	DCR	M
	JZ	ASCPL
	INR	M
	CPI	16
	JC	INCXY-2
	MOV	A,M
	RLC
	ADD	M
	LXI	H,PLTAB-6
	ADD	L
	MOV	L,A
	MOV	A,M	;PLOFL NEW VALUE
	INR	L
	MOV	C,M	;PLOT SUBR ADDR
	INR	L
	MOV	B,M
	LXI	H,PLOFL
	ADD	M
	MOV	M,A	;PLOFL NEW VAL
	MOV	A,E
	PUSH	B
	MOV	B,A
	MVI	L,YDATA AND 255
	RET

	MOV	A,C
	MVI	E,XYTAB AND 255
	CALL	PUTXD
PUTYD:	MVI	L,ODDFL AND 255
	MOV	A,B	;YDATA
	CPI	NOLIN*4
	JC	$+5
	SUI	NOLIN*4
	MOV	B,A
	ANI	3	;A=O,1,2,3
	RLC
	ADD	E
	ADD	M
	MOV	L,A
	MVI	H,BARTY SHR 8
	MOV	E,M	;PLOT CHARACTER
	LXI	H,YDATA
	MOV	M,B
	MOV	A,B
	ANI	252
	RRC
	RRC
	MOV	B,A
	MVI	L,PCRAD AND 255
	MOV	C,M
	MVI	L,VFILL+1 AND 255
	MOV	D,M
	CALL	LN5Y
	INR	L
PXYCH:	MOV	A,M	;STATUS WORD
	MOV	M,D
	DCR	L
	XRA	D
	MOV	A,M
	MOV	M,E
	RM	;OLD CHA NO PL
	JZ	ORCHA
	XRI	255
	RZ	;OLD CH DIF COL
	CMA
ORCHA:	XRA	E
	MOV	M,A
	LDA	COLFL
	ANA	A
	RNZ
	MOV	A,E
	ORA	M
	MOV	M,A
	RET

;RETURN	FOR PXYCH

INCXY:	LHLD	XDATA
	CALL	SHIFF
	SHLD	XDATA
	JZ	LL10
	MOV	B,H
	MOV	C,L
	MOV	A,E
	CALL	SHIFF
	SHLD	XTWO
	RNZ
	SHLD	XDATA
	MOV	B,H
	MOV	C,L
	RET
MOVXY:	LHLD	XTWO
	SHLD	XDATA
	MOV	B,H
	MOV	C,L
	RET

BARTZ:	DB	07
	DB	70H
	DB	06
	DB	60H
	DB	03
	DB	30H
BARTY:	DB	0FH
	DB	0F0H
	DB	0EH
	DB	0E0H
	DB	0CH
	DB	0C0H
	DB	8H
	DB	80H
BARTX:	DB	1
	DB	11H
	DB	2
	DB	22H
	DB	4H
	DB	44H
	DB	8H
	DB	88H
XYTAB:	DB	1
	DB	10H
	DB	2
	DB	20H
	DB	4
	DB	40H
	DB	8
	DB	80H
PLTAB:	DB	1
	DW	PUTXD	;(2) PLOT X
	DB	-1
	DW	PLPTY	;(3) PLOT Y
	DB	0
	DW	PLINC	;(4) INC-XY
	DB	1
	DW	PXZER	;(5) BAR X
	DB	1
	DW	INVY	;(6) BAR X
	DB	-1
	DW	BARXM	;(7) BAR X
	DB	0
	DW	PBINX	;(8) INC BAR X
	DB	1
	DW	INVY-2	;(9) BAR Y
	DB	1
	DW	PUTXD	;(10) BAR Y
	DB	-1
	DW	BARYM	;(11) BAR Y
	DB	0
	DW	PBINY	;(12) INC BAR Y
	DB	1
	DW	PXZER	;(13) VECT X0
	DB	-1
	DW	VECTY	;(14) VECT Y0
	DB	0
	DW	INVEC	;(15) INC VECT

POTON:	MOV	M,E
	MVI	L,PLOFL AND 255
	MOV	M,E
	MVI	L,VFILL+1 AND 255
	MVI	A,80H
	ORA	M
	MOV	M,A
NROLL:	XRA	A
	STA	ROLLN
	CALL	GETBC
	JMP	SVCRS+6

PUTZZ:	MOV	C,A
	MOV	A,B
	CMP	M
	JZ	PUTYD-6
	MVI	A,3
	ANA	M
	CPI	2
	MOV	A,C
	MVI	E,BARTZ AND 255
	JZ	PUTYD-3
	MVI	E,BARTZ+4 AND 255
	JM	PUTYD-3
	JMP	BARYM+15

PUTXZ:	MVI	A,0F0H
	ANA	E
	MOV	E,A
	JMP	PXYCH
PUTYZ:	LDA	YZERO
	ANI	3
	JZ	PUTEZ-2
	CPI	2
	MVI	A,77H
	JZ	PUTEZ
	MVI	A,0FFH
	JP	PUTEZ
	MVI	A,33H
	JP	PUTEZ	;TRICK
	ORG	$-2

	MVI	A,11H
PUTEZ:	ANA	E
	MOV	E,A
	RET

PLOKB:	MVI	A,KBDFL AND 255
	CMP	L
	RNZ
	MVI	A,0B0H
	ANA	E
	XRI	0B0H
	RNZ
	MOV	A,E
	ORI	0F0H
	MOV	E,A
	STA	KBCHA
	RET
ASCPL:	INR	M
	MOV	A,E
	CALL	STOR1-3
	JMP	JUMP

CPLOX:	MOV	A,E
	CPI	16	;32 FOR#
	JC	SVCHA
	CPI	24	;31H FOR #
	JNC	SVCHA	;RNC FOR #
	ANI	7
	ADI	0FCH
	RAL
	ADI	XYTAB AND 255
	MOV	L,A
	MVI	H,XYTAB SHR 8
	MOV	E,M
	LHLD	VHLAD
	INR	L
	LDA	VFILL+1
	ORI	80H
	MOV	D,A
	MOV	A,M
	MOV	M,D
	DCR	L
	XRA	D
	MOV	A,M
	MOV	M,E
	RM
	XRA	E
	MOV	M,A
	RET

	;START POINT:	X1=XDATA, Y1=YDATA
	;END POINT:	X0=XZERO, Y0=YZERO

VECT0:	DCR	L	;POINT TO X0
	MOV	C,M	;GET X0
	LHLD	XDATA	;L=X1, H=Y1
	SHLD	XTWO	;STORE PRESENT POSITION
	PUSH	H	;SAVE PRESENT POSITION
	MOV	A,B	;GET NEW Y
	SUB	H	;COMPUTE YCHANGE
	MVI	H,1	;ASSUME YSTEP OF +1
	JNC	LL1	;YCHANGE IS + OR 0
	MVI	H,-1	;SET YSTEP OF -1
	CMA		;COMPUTE MAGNITUDE ...
	INR	A	;... OF YCHANGE
LL1:	MOV	D,A	;SAVE YCHANGE MAGNITUDE
	MOV	A,C	;GET NEW X
	SUB	L	;COMPUTE XCHANGE
	MVI	L,1	;ASSUME XSTEP OF +1
	JNC	LL2	;XCHANGE IS + OR 0
	MVI	L,-1	;SET XSTEP OF -1
	CMA		;COMPUTE MAGNITUDE ...
	INR	A	;... OF XCHANGE
LL2:	MOV	E,A	;SAVE XCHANGE MAGNITUDE
	SHLD	TEMP0	;STORE XSTEP AND YSTEP
	POP	B	;GET PRESENT POSITION
	CMP	D	;XCHANGE >= YCHANGE ?
	JNC	LL6	;YES
	MOV	A,D	;GET YCHANGE
	ANA	A	;CLEAR C-BIT
	RAR		;HALVE YCHANGE
LL3:	SUB	E	;SUBTRACT SMALL CHANGE
	JNC	LL4	;DON'T STEP X THIS TIME
	ADD	D	;ADD LARGE CHANGE
	PUSH	PSW	;SAVE COUNTER
	LDA	TEMP0	;GET XSTEP
	ADD	C	;ADD X
	MOV	C,A	;SET NEW X
	MVI	A,0F5H	;GO STEP Y
	ORG	$-1	;TRICK SKIP TO LL5
LL4:	PUSH	PSW	;SAVE COUNTER
LL5:	LDA	TEMP1	;GET YSTEP
	ADD	B	;ADD Y
	MOV	B,A	;SET NEW Y
	PUSH	D	;SAVE D&E
	PUSH	B	;SAVE B&C
	CALL	PUTYD-6	;PLOT THIS POINT
	POP	B	;RESTORE B&C
	POP	D	;RESTORE D&E
	LDA	YZERO	;GET END Y
	CMP	B	;FINISHED ?
	JZ	LL10	;YES
	POP	PSW	;RESTORE COUNTER
	JMP	LL3	;LOOP
LL6:	ORA	A	;XCHANGE = 0 ?
	RZ		;YES: RETURN TO CALLER
	RAR		;HALVE XCHANGE (C IS 0)
LL7:	SUB	D	;SUBTRACT SMALL CHANGE
	JNC	LL8	;DON'T STEP Y THIS TIME
	ADD	E	;ADD LARGE CHANGE
	PUSH	PSW	;SAVE COUNTER
	LDA	TEMP1	;GET YSTEP
	ADD	B	;ADD Y
	MOV	B,A	;SET NEW Y
	MVI	A,0F5H	;GO STEP X
	ORG	$-1	;TRICK SKIP TO LL9
LL8:	PUSH	PSW	;SAVE COUNTER
LL9:	LDA	TEMP0	;GET XSTEP
	ADD	C	;ADD X
	MOV	C,A	;SET NEW X
	PUSH	D	;SAVE D&E
	PUSH	B	;SAVE B&C
	CALL	PUTYD-6	;PLOT THIS POINT
	POP	B	;RESTORE B&C
	POP	D	;RESTORE D&E
	LDA	XZERO	;GET END X
	CMP	C	;FINISHED ?
	JZ	LL10	;YES
	POP	PSW	;RESTORE COUNTER
	JMP	LL7	;LOOP
LL10:	POP	PSW	;CLEAN STACK
	RET		;RETURN TO CALLER

TIM3X:	CALL	SAVE
	CALL	KEYBD
	RC
	JZ	BREAK
	JMP	KEYCO

KEYBD:	LDA	KEDEL
	OUT	TIME3
Q01:	LXI	B,0FFFH	;INIT. ROW COUNTER & 1ST KEYCODE
	MOV	E,C	;INITIALIZE 2ND KEYCODE
Q02:	MOV	A,B	;GET COMPLEMENT OF NEXT ROW NUMBER
	OUT	EXTOT	;SEND
	IN	EXTIN	;READ
	INR	A	;GOT ANY ?
	JZ	Q06	;NO
	INR	E	;ALREADY SEEN TWO KEYS ?
	JNZ	ROT	;YES: MORE THAN TWO KEYS: IGNORE
Q03:	DCR	A	;RESTORE
	STC		;SET <C> BIT
Q04:	INR	E
	RAR		;FOUND IT ?
	JC	Q04	;NO
	PUSH	PSW
	MOV	A,E	;GET GROUP CODE
	ADD	A	;POSITION IT ...
	ADD	A
	ADD	A
	ADD	A
	ORA	B	;MERGE COMPLEMENT OF ROW NUMBER
	XRI	0FH	;MAKE ROW NUMBER RIGHT
	INR	C	;IS THIS 1ST KEY SEEN ON THIS ROW ?
	JZ	Q05	;YES
	MOV	E,A	;COPY 2ND KEYCODE SEEN
	POP	PSW
	INR	A	;ANY MORE ON THIS ROW ?
	JNZ	ROT	;YES: MORE THAN TWO KEYS
	DCR	C	;RESTORE 1ST KEYCODE SEEN
	JMP	Q06
Q05:	MOV	C,A	;SAVE 1ST KEYCODE SEEN
	POP	PSW
	INR	A	;ANY MORE ON THIS ROW ?
	JNZ	Q03	;YES
	MVI	E,-1	;RE-INIT. 2ND KEYCODE
Q06:	DCR	B	;SCANNED ALL ROWS ?
	JP	Q02	;NO: READ NEXT ROW
	INR	C	;SEE ANY KEYS ?
	JNZ	Q08	;YES
Q07:	XRA	A
	STA	LKC	;CLEAR "LAST" KEYCODE
	STA	NKC	;CLEAR "NEW" KEYCODE
;
ROT:	LDA	EXTBF
	OUT	EXTOT	;RESTORE OUTPUT PORT
	ORI	1
	STC
	RET		;EXIT
;
Q08:	DCR	C	;RESTORE 1ST KEYCODE
	INR	E	;SEE TWO KEYS ?
	JNZ	Q09	;YES
; SAW ONE KEY :
	XRA	A
	STA	NKC	;CLEAR "NEW" KEYCODE
	LDA	LKC	;GET "LAST" KEYCODE
	CMP	C	;MATCH ?
	JNZ	Q10	;NO
	MVI	A,80H
	OUT	EXTOT	;SELECT 'B' HIBITS
	IN	EXTIN	;READ
	ANI	40H	;REPEAT ?
	JNZ	ROT	;NO
	LXI	H,SEC15	;POINT TO DELAY COUNTER
	DCR	M	;IS IT TIME FOR ANOTHER ?
	JNZ	ROT	;NO: NOT YET
	JMP	Q11
; SAW TWO KEYS :
Q09:	DCR	E	;RESTORE 2ND KEYCODE
	LDA	LKC	;GET "LAST" KEYCODE
	CALL	Q20	;MATCH ?
	JZ	ROT	;YES: DO NOTHING
	LDA	NKC	;GET "NEW" KEYCODE
	CALL	Q20	;MATCH ?
	JNZ	Q07	;NO
Q10:	MOV	A,C	;GET KEYCODE
	STA	LKC	;SAVE "LAST" KEYCODE
Q11:	LDA	CHTIM	;SCANS/CHAR. IN REPEAT MODE
	STA	SEC15	;SET REPEAT TIME COUNTER
	MOV	A,C	;GET KEY CODE
	CPI	50H	;SPECIAL GROUP ?
	JC	Q12	;NO: NORMAL
	CPI	56H	;SPECIAL GROUP ?
	JC	Q16	;YES
Q12:	RRC		;ROTATE ...
	RRC
	RRC
	RRC
	ANI	7	;GET GROUP CODE
	MOV	E,A	;COPY GROUP CODE
	MVI	A,80H
	OUT	EXTOT	;SELECT 'B' HIBITS
	IN	EXTIN	;READ
	ANI	30H	;GET CONTROL & SHIFT BITS
	RLC
	RLC
	ORA	E	;MERGE WITH GROUP CODE
	RLC
	RLC
	MOV	E,A
	MVI	D,0
	LXI	H,KTAB-4 ;POINT TO TRANSLATE TABLE
	DAD	D	;INDEX
	MVI	A,0FH
	ANA	C	;GET ROW NUMBER
	ORA	M	;MERGE WITH TABLE ENTRY
	MOV	E,A	;SAVE
	MOV	A,C	;GET KEYCODE
	CPI	7CH
	JNC	Q13	;WEIRD
	SUI	1CH
	CPI	20H-1CH
	JNC	Q14	;NOT WEIRD
Q13:	MVI	A,10H
	XRA	E	;FIX WEIRD
	MOV	E,A
Q14:	IN	EXTIN	;READ 'B' HIBITS
	ANA	A	;CAPS LOCK ?
	JP	Q15	;YES: O.K.
	MOV	A,E	;GET ASCII CODE
	SUI	'A'
	CPI	'Z'+20H+1-'A'
	JNC	Q15	;NOT ALPHA
	SUI	'Z'+1-'A'
	CPI	'A'+20H-'Z'-1
	JC	Q15	;NOT ALPHA
	MVI	A,20H
	XRA	E	;FLIP SHIFT
	MOV	E,A
Q15:	CALL	ROT	;RESTORE OUTPUT PORT
	MVI	A,80H	;SET UP READY FLAG
	STA	READY
	ORA	A	;SET SIGN BIT = GOOD KEY
	MOV	A,E	;GET CHAR.
	STA	KBCHA	;STORE IT
	RET		;AND EXIT
;
Q16:	STA	READY	;SET READY = 50H IF BREAK
	SUI	50H	;ADJUST CODE
	STC		;CARRY AND ZERO IS BREAK
	RZ		;CODE IS BREAK
	MVI	E,127	;MAY BE DELETE
	CPI	4	;IS IT DELETE ?
	JZ	Q15	;YES: GO DO IT
	MOV	E,A
	MVI	A,6	;MAP 5==>1,3==>3,2==>4,1==>5
	SUB	E
	MOV	E,A
	JMP	Q15	;PROCESS IT
;
Q20:	CMP	C	;MATCH THIS ONE ?
	JZ	Q21	;YES
	MOV	L,C	;SWITCH THEM ...
	MOV	C,E
	MOV	E,L
	CMP	C	;MATCH THIS ONE ?
	RNZ		;NO MATCH: EXIT <NZ>
Q21:	MOV	A,E	;GET KEYCODE THAT DOES NOT MATCH
	STA	NKC	;STORE IT AS "NEW" KEYCODE
	RET		;MATCH: EXIT <Z>

SAVE:	XTHL	;SAVE HL WHILE LOADING ADDRESS
	PUSH	D	;TO RESUME EXECUTION AT,
	PUSH	B	;THEN SAVE ALL REGISTERS
	PUSH	PSW	;AND STATUS
	CALL	JMPHL	;PUSH $+3 AS RETURN ADDRESS
	POP	PSW	;AND RESUME EXECUTION OF CALLER
	POP	B	;THEN RESTORE ALL REGISTERS
	POP	D	;AND STATUS
	POP	H	
	EI		;REENABLE INTERUPTS
	RET		;AND EXIT FROM INTERUPT

JMPHL:	PCHL		;JUMP THRU HERE TO ROUTINE

KTAB:	DB	0A0H	;1 CS
	DB	020H	;1 -S
	DB	0B0H	;1 C-
	DB	030H	;1 --
	DB	080H	;2 CS
	DB	060H	;2 -S
	DB	000H	;2 C-
	DB	040H	;2 --
	DB	090H	;3 CS
	DB	070H	;3 -S
	DB	010H	;3 C-
	DB	050H	;3 --
	DB	0E0H	;4 CS
	DB	0D0H	;4 -S
	DB	0C0H	;4 C-
	DB	0F0H	;4 --
	DB	080H	;5 CS
	DB	080H	;5 -S
	DB	000H	;5 C-
	DB	000H	;5 --
	DB	090H	;6 CS
	DB	090H	;6 -S
	DB	010H	;6 C-
	DB	010H	;6 --
	DB	020H	;7 CS
	DB	020H	;7 -S
	DB	020H	;7 C-
	DB	020H	;7 --

ZZZZZZ:
;	END OF SYSTEM *********************************
;
;
