iocontrol.asm
rricharz_R65/R65-Emulator/Assembler/iocontrol.asm
*                             15/8/82 RB
*   ************************************
*   * IO CONTROLLER FOR R65/JOB SYSTEM *
*   ************************************
*
* EPROM VERSION 1 15/08/79 RB
* REVISION 2.3    10/05/82
* CC 1978 - 1982 RRICHARZ RBAUMANN
*
	TIT R65/JOB I/O CONTROL
*
* THE I/O CONTROLER DRIVES THE FOLLOWING
* INTERFACES OF THE R65/JOB SYSTEM:
* - AUDIO TAPE RECORDING AND WRITING
* - SYSTEM TIME OF DAY CLOCK UPDATE
*
PSTART	EQU $E800	START OF PROGRAM
*
* PAGE ZERO AREA:
*****************
*
* TAPE LOAD AND STORE TEMPORARIES
*
	ORG $DA
*
FILFLG	BSS 1	FILE ENTRY FLAGS
*		BIT 7 1=PROTECTED
*		BIT 6 1=NO PRINTING
*		BIT 5 1=WRITE, 0=READ
*
FILERR	BSS 1	FILE HANDLING ERROR
*		01 DISK OR TAPE READ ERROR
*		02 CHECKSUM ERROR
*		03 ESCAPE EXIT DURING R/W
*		04 RECORD NO ERROR ON TAPE
*		05 FILE TYPE ERROR
*
FILDRV	BSS 1	TAPE OR DISK DRIVE
*
* TEMPORARY AREA FOR TAPE AND DISK R/W
*
TRECID	BSS 2	RECORD ID OF FIRST RECORD
TRECNO	BSS 1	RECORD NUMBER
TRECST	BSS 2	START ADDRESS POINTER
TRECSI	BSS 1	RECORD SIZE
TCOUNT	BSS 1	TEMPORARY COUNTER
TTRIB	BSS 1
TGANG	BSS 1
TCNT1	BSS 1
*
* PAGE ZERO DATA AREA
*********************
*
	ORG $E7
FETCH	BSS 2	REGISTER FOR DATA ROUT.
VIDPNT	BSS 2	VIDEO POINTER
VIPNT2	BSS 2	SECOND VIDEO POINTER
CURLIN	BSS 1	CURSOR LINE
CURPOS	BSS 1	CURSOR POSITION
SAVPC	BSS 2	PROCESSOR PC SAVE
SAVST	BSS 1	PROCESSOR STATUS SAVE
SAVSP	BSS 1	PROCESSOR STACK PN SAVE
SAVACC	BSS 1	PROCESSOR A SAVE
SAVYRG	BSS 1	PROCESSOR Y SAVE
SAVXRG	BSS 1	PROCESSOR X SAVE
CHKHI	BSS 1
CHKSUM	BSS 1
INL	BSS 2	MONITOR INPUT POINTER
POINT	BSS 2	OPEN CELL POINTER
TEMP	BSS 1
TEMPX	BSS 1
KCHAR	BSS 1
MODE	BSS 1
*
* PAGE 3 2/3 DATA AREA
**********************
*
	ORG $200
RSBUFF	BSS 256
*
* FILE LABEL AREA
*
FILTYP	BSS 1	TYPE OF ACTIVE FILE
FILNAM	BSS 16	FILE NAME
FILCYC	BSS 1	CYCLUS NUMBER
FILSTP	BSS 1	FILE SUBTYPE
FILLOC	BSS 2	LOCATION OR SECTOR
FILSIZ	BSS 2	FILE SIZE
FILDAT	BSS 3	FILE GENERATION DATE
FILSA	BSS 2	START ADDRESS
FILEA	BSS 2 	END ADDRESS
FILLNK	BSS 2	FILE LINK
*
FILNM1	BSS 16
FILCY1	BSS 1
FILSA1	BSS 2
SAVRST	BSS 2
*
	PAG
*
* PAGE 17 DATA AREA
*******************
*
	ORG $1780
VFLAG	BSS 1
SFLAG	BSS 1
*
	BSS 23	CRT-CONTROLLER DATA AREA
*
IRQACC	BSS 1	IRQ ACCU SAVE
*
NMI	BSS 2	NMI VECTOR
PRIOTB	BSS 16	PRIORITY IRQ VECTORS
BREAK	BSS 2	BREAK VECTOR
SAVVEC	BSS 2	VECTOR SAVE FOR IBM
IBMCT	BSS 1	IBM TIMER COUNTER
IBCASE	BSS 1	IBM UPPER/LOWER CASE
*
IBMFLG	BSS 1	FROM ORIGINAL VERSION
RSFIFO1	BSS 1	FIFO INPUT POINTER
RSFIFO2	BSS 1	FIFO OUTPUT POINTER
TIME	BSS 4	1/20SEC,SEC,MIN,HOUR
DATE	BSS 3	DAY,MONTH,YEAR
*
	ORG $17E7
CHKL	BSS 2	TAPE CHECKSUM
SAVX	BSS 3	TAPE SAVE X
*
* VECTORS TO CTR-CONTROLLER
***************************
*
GETKEY	EQU $E000	GET KEY FROM KEYBOARD
PRTCHR	EQU $E009	PRINT A CHAR TO CRT
PRTINF	EQU $E027	PRINT A STRING
PRTHEX	EQU $E02A	PRINT HEX CHAR
PRTBYT	EQU $E02D	PRINT BYTE IN A
PRTAX	EQU $E030	PRINT TWO BYTES
KEYIRQ	EQU $E036	KEYBOARD IRQ
IRQ9	EQU $E03E	DUMMY IRQ HANDLER
*
* VECTORS TO KIM-1
******************
*
CHKT	EQU $194C	*** COMPUTE CHECKSUM
RDCHTK	EQU $1A24	*** GET CHAR FROM TAPE
TRDBIT	EQU $1A41	*** READ BYTE FROM TAPE
KINIT1	EQU $1E8C	*** INITIALIZE TAPE IO
KINIT2	EQU $1E93	*** INITIALIZE TAPE IO
OUTCH	EQU $1EA0	*** PRINT CHAR ON TTY
*
* VECTORS TO DISK CONTROLLER
****************************
*
DWRFIL	EQU $F000	WRITE DISK FILE
DRDFIL	EQU $F003	READ DISK FILE
*
* VECTORS TO MONITOR
********************
ILLIRQ	EQU $F803	ILLEGAL INTERRUPT
ADAPT	EQU $F818
*
* INTERFACE CONTROL REGISTERS
* ***************************
*
PORTB1	EQU $1440	6552-1
DIRB1	EQU $1442	DIRECTION OF PORTB1
*
TLC11	EQU $1444	6522-1 TIMER 1
THC11	EQU $1445
TLL11	EQU $1446
THL11	EQU $1447
*
TLL21	EQU $1448	6552-1 TIMER 2
THC21	EQU $1449
*
SR1	EQU $144A
ACR1	EQU $144B	CONTROL REGISTER
IFR1	EQU $144D	IRQ FLAG REGISTER
IER1	EQU $144E	IRQ ENABLE REGISTER
*
PORTB2	EQU $1450	6522-2
DIRB2	EQU $1451
PORTA2	EQU $1451	KEYBOARD REGISTER
*
TLC12	EQU $1454	6522-2 TIMER 1
THC12	EQU $1455	USED FOR TIME CLOCK
TLL12	EQU $1456
THL12	EQU $1457
*
ACR2	EQU $145B	CONTROL REGISTER
IFR2	EQU $145D
IER2	EQU $145E
CPRTA2	EQU $145F
*
PORTB3	EQU $1460	DAC
PORTA3	EQU $1461	ADC
DIRA3	EQU $1463
IFR3	EQU $146D
*
TAPAON	EQU $14E4	START TAPE A
TAPAOF	EQU $14E5	STOP TAPE A
TAPBON	EQU $14E6	START TAPE B
TAPBOF	EQU $14E7	STOP TAPE B
*
USPBD	EQU $1702
USPBDD	EQU $1703
*		BIT 0: TAPE READ/WRITE
*		BIT 1: IBM PRINTING
*		BIT 2: DISK READ & WRITE
*
KMPBD	EQU $1742
KMC1T	EQU $1744	KIM TIMER
TMSEC	EQU $1747
*
RSADAT	EQU $14C8	RS232
RSASTA	EQU $14C9
RSACOM	EQU $14CA
RSACNT	EQU $14CB
*
	PAG
*	
* START OF PROGRAM
*
	ORG PSTART
*
* VECTORS FOR SUBROUTINE CALLS
******************************
*
	JMP PRTTTY	PRINT CHAR TO TTTY
	JMP RSTIOC	RESET I/O/CONTROL
	JMP ESCTST	ESCAPE TEST DURING I=1
	JMP TDIR	PRINT TAPE DIRECTORY
	JMP TWRFIL	WRITE TAPE FILE LABEL
	JMP TPWAIT	READY MESSAGE FOR TAPE
	JMP TRDREC	LOAD A RECORD FROM TAPE
	JMP RDFILE	LOAD A FILE FROM DRIVE
	JMP TWRREC	WRITE A RECORD TO TAPE
	JMP WRFILE	WRITE A FILE TO DRIVE
	JMP SETFID	SET DATE TO FILE LABEL
	JMP TAPEON	START TAPE
	JMP TAPEOF	STOP TAPE
	JMP TDELAY	DELAY 1 SEC
	JMP SETID	SET SET TAPE ID
	JMP PRFLAB	PRINT FILE LABEL
	JMP TRDLBR	READ LABEL RECORD
	JMP IRQ		IRQ POLLING ROUTINE
	JMP PRTRSA	PRINT TO NEEDLE PRINTER
*
* IRQ PRIORIY HANDLER
*********************
*
IRQ	STA IRQACC	SAVE A
	CLD
	PLA
	PHA
	AND =$10
	BEQ *+8		SKIP,IF NOT BREAK
	LDA IRQACC
	JMP (BREAK)
*
	LDA IRQACC
	PHA		SAVE A ON STACK
	TXA
	PHA		SAVE X ON STACK
	BIT IFR1
	BPL *+6
	LDX =2		SECOND LEVEL
	BNE VECTOR
	BIT IFR2
	BPL *+6
	LDX =0		FIRST LEVEL
	BEQ VECTOR
	BIT IFR3	
	BPL *+6
	LDX =4		THIRD LEVEL
	BNE VECTOR
	BIT RSASTA	WRITE IRQ?
	BPL *+6
	LDX =6
	BNE VECTOR
	LDX =$E		LAST LEVEL ILLEGAL
*
VECTOR	LDA PRIOTB+1,X	GET VECTOR
	PHA
	LDA PRIOTB,X
	PHA
	RTS		GO SERVE IRQ, A AND
*			X ARE ON STACK
*
*
* PRINT CHAR ON TTY
*******************
*
PRTTTY	CLD
	JSR ADAPT
	CMP =$0D
	BEQ *+6
	JSR OUTCH	OUTCH (KIM)
	RTS
*
	JSR OUTCH
	LDX =5
LOOP	LDA =0
	JSR OUTCH
	DEX
	BNE LOOP
	RTS
*
*	
* RESET I/O CONTROLLER SUBROUTINE
*********************************
*
RSTIOC	LDX =15		SET UP PRIORITY
	LDA IRQTB,X	TABLE
	STA PRIOTB,X
	DEX
	BPL *-7
*
	LDA ACR2	SET TIME CLOCK
	AND =$7F	DISABLE BP7 OUT
	ORA =$40	SET TO FREE RUNNING
	STA ACR2
	LDA =$50	SET TO 1/20 SEC
	STA TLL12	(50000 MICROSEC)
	LDA =$3C	=$C350
	STA THC12	AND START CLOCK
	LDA =$C0	ALLOW IRQ FROM T1
	STA IER2	OF 6522-2
	LDA =0
	STA RSFIFO1	CLEAR FIFO POINTERS
	STA RSFIFO2
	LDA =$02	INIT RS232 A
	STA RSACOM
	LDA =$1C	4800 BAUD
	STA RSACNT
	RTS
*
IRQTB	WRD TIMIRQ-1,EXIRQ-1,EXIRQ-1
	WRD RSIRQ-1,EXIRQ-1,EXIRQ-1
	WRD EXIRQ-1,EXIRQ-1
*
*
* IRQ HANDLER FOR 6522-2
************************
*
TIMIRQ	LDA =$02
	AND IER2
	BIT IFR2	IS IRQ FROM KEYBOARD
	BEQ *+5
	JMP KEYIRQ	YES, GO TO SERVE IT
*
	LDA =0
	AND IER2
	BIT IFR2	IS IRQ FROM TIMER1?
	BNE *+5
	JMP ILLIRQ	ILLEGAL IRQ FROM 6522-2
*
	LDA =$40
	STA IER2
	CLI		AND ALLOW OTHER IRQ
	LDA TLC12	CLEAR IRQ FLAG
*
	LDX =0		UPDATE NOW CLOCK
	SED
TIMIR1	LDA TIME,X	GET A BYTE
	CLC
	ADC =1		INCREMENT DECIMAL
	STA TIME,X
	CMP MAXVAL,X
	BCC TIMIR2	SKIP, IF NO OVERFLOW
	LDA =0
	STA TIME,X
	INX
	CPX =5		UPDATE UP TO DAYS
	BNE TIMIR1
*
TIMIR2	SEI
	LDA =$C0	ENABLE THIS IRQ AGAIN
	STA IER2
	CLD
EXIRQ	PLA		EXIT IRQ ROUTINE
	TAX
	PLA
	RTI
*
MAXVAL	BYT $20,$60,$60,$24,$31
*
*
* RSIRQ: NEEDLE PRINTER IRQ HANDLER
***********************************
*	
RSIRQ	BVC RSIRQ1	STOP TX IRQ IF DSR NOT
	LDA =$07			READY
	CMP RSACOM	TX IRQ SET?
	BEQ *+5		YES, SKIP
	STA RSACOM	NO, SET IT
	LDA RSASTA	GET STATUS
	AND =$10	TX EMPTY?
	BEQ EXIRQ	NO, EXIT
*
	LDA RSFIFO1	FIFO EMPTY?
	CMP RSFIFO2
	BNE RSIRQ2
*
RSIRQ1	LDA =$B		FIFO EMPTY OR DSR NOT
	STA RSACOM			READY
	BNE EXIRQ	ALLWAYS TAKEN
*
RSIRQ2	INC RSFIFO2
	LDX RSFIFO2
	LDA RSBUFF,X	GET A CHAR
	STA RSADAT	SEND IT
	JMP EXIRQ
*
*
* PRTRSA: PRINT TO RS232 A (FIFO)
*********************************
*
PRTRSA	TAX		SAVE CHAR
	CLI
*
PRTRSA1	LDA RSFIFO2	IS FIFO FULL?
	CLC
	SBC RSFIFO1
	BEQ PRTRSA1	YES, WAIT
*
	SEI
	INC RSFIFO1	NO, CONTINUE
	LDY RSFIFO1
	TXA
	STA RSBUFF,Y
	LDA =7
	CMP RSACOM	IS TX IRQ SET
	BEQ RSEND	YES, SKIP
*
	STA RSACOM	NO, SET IT
*
RSEND	CLI
	RTS
*
*
* TWRREC: WRITE RECORD TO TAPE
******************************
*
* RECORD FORMAT:(64*SYNCH),$2A,ID(2),RECNO
*   RESIZE,1-256 BYTE BINARY DATA,$2F,CHECKS
*
* THIS SUBROUTINE ASSUMES, THAT THE DRIVE IS ON
* ESCAPE GIVES EXIT FRO TWRREC WITH A=3
*
* ENTRY PARAMETERS: TRECID,TRECNO,TRECST
*	RECORD SIZE IN A (1-256 BYTES)
* EXIT CONDITIONS: STATUS IN A
*
TWRREC	INC TRECNO	COUNT THIS RECORD
	STA TRECSI	SAVE RECORD SIZE
	JSR TWRSYN	INITIALIZE, WRITE SYNCH
	BNE CLLED1	ERROR EXIT
	LDA =$2A
	JSR TWRBT	WRITE START MARK
	LDA TRECID
	JSR TWRBTC	WRITE ID, START CHECKS
	LDA TRECID+1
	JSR TWRBTC
	LDA TRECNO
	JSR TWRBTC	WRITE RECORD NO
	LDA TRECSI
	JSR TWRBTC	WRITE RECORD SIZE
*
TWRRE1	LDY =0
	LDA (TRECST),Y
	JSR TWRBTC	WRITE DATA BYTE
	INC TRECST
	BNE *+4
	INC TRECST+1
*
	DEC TRECSI	COUNT THIS BYTE
	BNE TWRRE1
*
	LDA =$2F		END OF DATA MARK
	JSR TWRBTC
	LDA CHKL
	JSR TWRBT	WRITE CHECKSUM
	LDA CHKL+1
	JSR TWRBT
	LDA =$16	END OF RECORD MARK
	JSR TWRBT
	LDA =0		A=0: NORMAL EXIT
*
CLLED1	RTS
*
* WRITE BYTE TO TAPE
********************
*
TWRBTC	JSR CHKT	UPDATE CKECKSUM
*
TWRBT	LDY =7
	STY TCOUNT
TWRBT1	LDY =2
	STY TTRIB
TWRBT2	LDX TWRBT6,Y
	PHA
TWRBT3	BIT TMSEC
	BPL TWRBT3
	LDA TWRBT6+1,Y
	STA KMC1T
	LDA TGANG
	EOR =$80
	STA KMPBD
	STA TGANG
	DEX
	BNE TWRBT3
	PLA
	DEC TTRIB
	BEQ TWRBT4
	BMI TWRBT5
	LSR A
	BCC TWRBT2
TWRBT4	LDY =0
	BEQ TWRBT2
TWRBT5	DEC TCOUNT
	BPL TWRBT1
	JSR ESCTST	ESCAPE?
	BCS *+3
	RTS
*
TEXIT	LDA =3		ESCAPE DURING R/W
	TAX
	PLA
	PLA
	TXA
TEXIT1	DEC TRECNO	DO NOT COUNT RECORD
	CMP =0		SET Z
	RTS
*
TWRBT6	BYT $2,$c3,3,$7E
*
* INITIALIZE WRITE AND WRITE SYNC
*********************************
*
TWRSYN	LDA =0	CLEAR CHECKSUM
	STA CHKL
	STA CHKL+1
	LDA =$27
	STA TGANG
	LDX =$BF
	JSR KINIT2	INITIALIZE KIM TAPE IO
	LDX =64	AND SET I
	STX TCNT1
TWRHIC	LDA =$16	SYNCH COUNTER
	JSR TWRBT
	DEC TCNT1
	BNE TWRHIC
	RTS		NORMAL EXIT, C=1
*
* TRDREC: READ RECORD FROM TAPE
*******************************
*
* THIS ROUTINE ASSUMES, THAT THE DRIVE IS
* ON, IIS SET TO 1
* IF FILFLG, BIT 6=0 AND ERROR, SEVERALTRIES
* ARE DONE, UNTIL NO ERROR OR ESCAPE
*
* ENTRY PARAMETERS: TRECID, TRECNO,TRECST,FILFLG
* EXIT PARAMETERS: STATUS IN A
*
TRDREC	INC TRECNO	COUNT RECORD
*
	LDA TRECST	SAVE RECORDSTART
	LDX TRECST+1
	STA SAVRST
	STX SAVRST+1
	JSR TRDSYN	INITIALIZE AND SYNCH
	JSR TRDBTC	GET ID LOW
	CMP TRECID
	BNE TRDREC+2
	JSR TRDBTC	GET ID HIGH
	CMP TRECID+1
	BNE TRDREC+2
	JSR TRDBTC	GET RECORD NO
	CMP TRECNO
	BEQ TRDRE0
*
	BCC TRDREC+2	TRY AGAIN, IF SMALLER
	LDA =4		RECORD NUMBER ERROR
	BIT FILFLG
	BVS TEXIT1	EXIT WITH ERRROR 4
*
	JSR TREWD	OR REWIND ONE RECORD
	BCC TRDREC+2	AND SEARCH AGAIN, OR
TEXIT3	LDA =3		IF ESCAPE WAS PRESSED
	JMP TEXIT1	EXIT WITH ERROR3
*
TRDRE0	JSR TRDBTC	GET RECORD SIZE
	STA TRECSI
*
TRDRE1	JSR TRDBTC	GET ONE DATA BYTE
	LDY =0
	STA (TRECST),Y
	INC TRECST
	BNE *+4
	INC TRECST+1
*
	DEC TRECSI	COUNT DATA BYTE
	BNE TRDRE1
*
	JSR TRDBTC	READ END OF DATA MARK
	CMP =$2F
	BNE TRDRE8
	JSR TRDBT	GET CHECKSUM LOW
	CMP CHKL
	BNE TRDRE9
	JSR TRDBT	GET CHECKSUM HIGH
	CMP CHKL+1
	BNE TRDRE9
	LDA =0		A=0, NORMAL EXIT
	RTS		Z=1
*
TRDRE8	LDA =1		READ ERROR
	BNE TRDRE9+2	SLLWAYS TAKEN
*
TRDRE9	LDA =2		CHECKSUM ERROR
	BIT FILFLG	MESSAGE ALLOWED?
	BVS TEXIT3+2	IF NOT, ERROR EXIT
*
	LDX SAVRST	SAME START ADDRESS
	LDY SAVRST+1	AGAIN FOR NEXT TRY
	STX TRECST
	STY TRECST+1
	JSR TREWD	REWIND ONE RECORD
	BCS *+5
	JMP TRDREC+2	TRY AGAIN
	JMP TEXIT3	OR ESCAPE EXIT
*
*
* READ BYTE FROM TAPE
*********************
*
TRDBTC	JSR TRDBT
	PHA
	JSR ESCTST	ESCAPE?
	BCC TRDBT2
*
TEXIT2	PLA		ESCAPE
	JMP TEXIT	ALWAYS TAKEN
*
TRDBT2	PLA
	JMP CHKT	UPDATE CHECKSUM
*
TRDBT	JSR RDCHTK
	LDA SAVX+1
	RTS
*
* SYNCHRONIZE AND INITIALIZE
*
TRDSYN	LDA =0		CLEAR CHECKSUM
	STA CHKL
	STA CHKL+1
	JSR KINIT1	INITIALIZE KIM TAPE IO
TRDSY1	LDX =$FF
	STX SAVX
TRDSY2	JSR ESCTST	ESCAPE?
	BCS TEXIT2+1
	JSR TRDBIT
	LSR SAVX
	ORA SAVX
	STA SAVX
	CMP =$16	SYNCH?
	BNE TRDSY2
*
TRDSY3	LDX =8		READ 8 SYNCH CHARS
	JSR TRDBT
	CMP =$16
	BNE TRDSY1
	DEX
	BNE TRDSY3+2
*
TRDSY4	JSR TRDBT
	CMP =$2A
	BEQ TRDSY5
	CMP =$16
	BNE TRDSY1
	BEQ TRDSY4
*
TRDSY5	RTS
*
* WRFILE: WRITE BLOCK FILE
**************************
*
* ENTRY CONDITIONS: FILNAM,FILCYC,FILSA
*   FILEA,FILDRV,FILSTP,FILLOC (TAPE ONLY)
*   FILFLG
*
* EXIT CONDITION: FILERR AND A
*
WRFILE	LDA FILSA	USE SAME BLOCK TO
	STA FILSA1	STORE AS DEFINED
	LDA FILSA+1	IN DIRECTORY
	STA FILSA1+1
*
	JSR SETFID	SET DATE TO FILE DATE
	LDA FILFLG
	AND =$80	MASK PROTECTED FLAG
	ORA ='B'	B = BLOCK FILE
	STA FILTYP
	CLD
	SEC
	LDA FILEA	COMPUTE FILSIZ
	SBC FILSA
	STA FILSIZ
	LDA FILEA+1
	SBC FILSA+1
	STA FILSIZ+1
	INC FILSIZ
	BNE *+5
	INC FILSIZ+1
*
*
	LDA =2	MASK FOR DRIVE TYPE
	BIT FILDRV
	BNE *+5
	JMP DWRFIL	WRITE DISK FILE
*
* TWRFIL: WRITE FILE TO TAPE
****************************
* IF FILSIZ(2)=0, ONLY THE LABEL RECORD IS
* WRITTEN, FILSA1 AND FILSIZ ARE USED AS THE
* DATA POINTERS, TRECST IS INCREMENTED
*
TWRFIL	JSR SETFLB
	BIT FILFLG
	BVS TWRFI0	SKIP, IFNOT OUTPUT
*
	JSR PRTINF
	BYT $D,$A,$E,'STORING',$8B
*
TWRFI0	SEI
	JSR TAPEON
	JSR TDELAY
*
	LDA =32
	JSR TWRREC	WRITE LABEL RECORD
	BNE TWRFI2	SKIP, IF ERROR
	JSR TDELAY
*
	JSR SETID
	LDA FILSA1	USE FILSA1 AS START
	STA TRECST	OF DATA IN MEMORY
	LDA FILSA1+1
	STA TRECST+1
*
TWRFI1	DEC FILSIZ+1	LOOP FOR FULL RECORDS
	BMI TWRFI3
	LDA =0
	JSR TWRREC
	BEQ TWRFI1
	BNE TWRFI2	ERROR EXIT
*
TWRFI3	LDA FILSIZ
	BEQ TWRFI4
	JSR TWRREC
	BNE TWRFI2
*
TWRFI4	JSR TDELAY	ONE SECOND TAPE AT END
	LDA =0		NORMAL EXIT
TWRFI2	STA FILERR
	BIT FILFLG
	BVS TWRFI5
	JSR PRTINF
	BYT $D,$9A	CLEAR LINE
*
TWRFI5	JSR TAPEOF
	JSR PRTINF
	BYT $87		BELL
	CLI
	LDA FILERR
	RTS
*
* SET DATE TO FILE DATE
***********************
*
SETFID	LDX =2
	LDA DATE,X
	STA FILDAT,X
	DEX
	BPL SETFID+2
	RTS
*
* TAPE ON
*********
*
TAPEON	CLC	CARRY IS ON OR OFF
	LDA FILDRV
	ROL A
	AND =3
	TAX
	LDA TAPAON,X
	RTS
*
* TAPE OFF
**********
*
TAPEOF	SEC
	BCS TAPEON+1	ALLWAYS TAKEN
*
* TDELAY: DELAY 1 SECOND
************************
* CAN BE USED BY ANY NON IRQ ROUTINE
*
TDELAY	LDY =3
	LDA =255
	STX TMSEC
	LDX TMSEC
	BPL *-3
	DEY
	BPL *-11
	RTS
*
* COMPUTE ID
************
*
SETID	LDA =0
	STA TRECID
	STA TRECID+1
	LDX =16
SETID1	LDA FILNAM,X
	CLC
	ADC TRECID
	STA TRECID
	BCC SETID2
	INC TRECID+1
SETID2	DEX
	BPL SETID1
	RTS
*
*
* RDFILE: READ FILE FROM TAPE OR DISK
*************************************
*
* ENTRY CONDITIONS: FILFLG,FILNM1,FILCY1,
*    FILSA1,FILDRV
* EXIT CONDITIONS: FILERR AND A
*
RDFILE	CLD
	LDA =2
	BIT FILDRV
	BNE TRDFIL	TAPE FILE READ
	JMP DRDFIL	DISK FILE READ
*
* TDRLBR: READ LABEL RECORD
***************************
*
TRDLBR	JSR SETFLB	READ LABEL RCORD
*
	BIT FILFLG
	BVS RDFIL1
	JSR PRTINF
	BYT $D,$A,$E,'SEARCHING',$8B
*
RDFIL1	SEI
	JSR TAPEON
	JSR TRDREC	GET LABEL RECORD
	BNE RDFIL9	SKIP, IF ERROR
*
	JSR TAPEOF
	LDA FILNM1
	BEQ RDFIL5	FILNM1=0, READ NEXT FILE
*
	LDX =15		COMPARE NOW NAME
RDFIL2	LDA FILNM1,X
	CMP FILNAM,X
	BNE RDFIL4	NOT MATCHING
	DEX
	BPL RDFIL2
*
	LDA FILCY1
	BEQ RDFIL5	FILCY1=0, READ EVERY CY
	CMP FILCYC
	BEQ RDFIL5	SKIP, IF NOT MATCHING
*
RDFIL4	BIT FILFLG
	BVS TRDLBR	CONTINUE SEARCHING
	JSR PRTINF
	BYT $D,$17,'FOUND:'+128
	JSR PRFLAB	PRINT FILE LABEL
	JMP TRDLBR	AND CONTINUE SEARCHING
*
RDFIL5	RTS
*
RDFIL9	STA FILERR	GET BACK ONE SUBR LEVEL
	PLA
	PLA
	JMP TWRFI5	ERROR EXIT
*
*
TRDFIL	JSR TRDLBR	READ LABEL RECORD
	LDA FILTYP	MUST BE BLOCK FILE
	AND =$7F
	CMP ='B'
	BEQ *+9
	LDA =5		FILE TYPE ERROR
RDFIL8	STA FILERR
	JMP TWRFI5
*
	LDA FILSA1	IF FILSA1(2)#0
	ORA FILSA1+1
	BEQ RDFIL6
	LDA FILSA1	SET NEW FILSA
	STA FILSA
	CLC
	ADC FILSIZ
	STA FILEA
	LDA FILSA1+1
	STA FILSA+1
	ADC FILSIZ+1
	STA FILEA+1
	LDA FILEA
	BNE *+5
	DEC FILEA+1
	DEC FILEA
*
RDFIL6	BIT FILFLG
	BVS RDFIL3
	JSR PRTINF
	BYT $D,$97
	JSR PRFLAB
	JSR PRTINF
	BYT $D,$A,$E,'LOADING',$8B
*
RDFIL3	JSR SETID
	JSR TAPEON
	LDA FILSA
	LDX FILSA+1
	STA TRECST
	STX TRECST+1
*
RDFIL7	JSR TRDREC	GET ONE RECPRD
	BNE RDFIL8	EXIT ERROR
	LDA FILEA
	CMP TRECST
	LDA FILEA+1
	SBC TRECST+1
	BCS RDFIL7
	LDA =0
	JMP TWRFI2	GOOD COMPLETION
*
* PRINT FILE LABEL
******************
*
PRFLAB	JSR PRTINF
	BYT $D,$8A
	LDX =0		PRINT NAME
	LDA FILNAM,X	
	JSR PRTCHR
	INX
	CPX =16
	BNE *-9
*
	JSR PRTINF
	BYT 128+'.'
	LDA FILCYC
	JSR PRTBYT	PRINT CYCLUS NUMBER
*
	LDA =' '
	JSR PRTCHR
	LDX FILTYP
	BPL *+4
	LDA ='P'	P=PROTECTED
	JSR PRTCHR
	TXA
	AND =$7F
	JSR PRTCHR	FILE TYPE
	LDA FILSTP
	JSR PRTCHR	FILE SUBTYPE
*
	JSR PRTINF
	BYT $A0
	LDA FILSA+1
	LDX FILSA
	JSR PRTAX	START ADDRESS
	JSR PRTINF
	BYT 128+'-'
	LDA FILEA+1
	LDX FILEA
	JSR PRTAX	END ADDRESS
*
	JSR PRTINF
	BYT $A0
	LDA FILLOC+1
	LDX FILLOC
	JSR PRTAX	LOCATION
*
	JSR PRTINF
	BYT $A0
	LDA FILDAT
	JSR PRTBYT
	JSR PRTINF
	BYT 128+'/'
	LDA FILDAT+1
	JSR PRTBYT
	JSR PRTINF
	BYT 128+'/'
	LDA FILDAT+2
	JSR PRTBYT	CONTINUE WITH ESC TEST
*
*
* ESCTST: ESCAPE TEST DURING I=1
********************************
*
ESCTST	LDA SFLAG
	BMI ESCTS1
	LDA PORTA2
	CMP =$91
	BEQ ESCTS2
	CMP =$1B
	BEQ ESCTS2
	CLC
	RTS
*
ESCTS1	AND =$7F
	STA SFLAG	CLEAR ESCAPE FLAG
ESCTS2	SEC
	RTS
*
*
* TREWD: REWIND TAPE ONE RECORD
*******************************
*
TREWD	JSR TAPEOF
	CLI
	JSR PRTINF
	BYT ' ',$E,'REWIND TAPE',$A0
	LDA FILDRV
	JSR PRTHEX
	JSR PRTINF
	BYT $7,$8B
	JSR GETKEY
	SEC
	BEQ *+7		IF ESCAPE
	CMP =$D
	BNE *-8		OR CR
	CLC
	PHP		SAVE c
	LDX =13
	LDA =$5F	RUBOUT MESSAGE
	JSR PRTCHR
	DEX
	BPL *-6
	JSR TAPEON
	PLP		RESTORE C (1=ESC)
	RTS
*
* SET FOR LABEL RECORD
*
SETFLB	LDA =0
	STA TRECNO
	STA TRECID
	STA TRECID+1
	LDA =<FILTYP
	STA TRECST
	LDA =>FILTYP
	STA TRECST+1
	RTS
*
*
* TDIR: TAPE DIRECTORY
**********************
* ENTRY CONDITIONS: FILDRV
* EXIT FROM THIS ROUTINE BY PRESSING ESCAPE
*
TDIR	LDA =$40	NO OUTPUT BY SUBROUTINE
	STA FILFLG
	LDA =0		TAKE EVERY LABEL RECORD
	STA FILNM1
	JSR TRDLBR	GET A LABEL RECORD
	JSR PRFLAB	AND PRINT INFORMATION
	JMP TDIR	LOOP
*
*
* TPWAIT: WAIT ON TAPE DRIVE READY
**********************************
* MESSAGE IS PRINTED, IF ALLOWED, RETURN MUST
* BE ANSWERED, C=1 IF ESCAPE WAS PRESSED, ELSE
* C=0
* FILDRV AND FILFLG (BIT 5,6) ARE USED
*
TPWAIT	LDA FILFLG	PRINTING ALLOWED?
	ASL A
	BMI TPWAI3-1	RTS IF NOT
*
	ASL A
	BMI TPWAI1	SKI, IF WRITE
*
	JSR PRTINF
	BYT $D,$A,'READ FROM'+128
	JMP TPWAI2
*
TPWAI1	JSR PRTINF
	BYT $D,$A,'WRITE TO'+128
*
TPWAI2	JSR PRTINF
	BYT ' TAPE '+128
	LDA FILDRV
	JSR PRTHEX
	JSR PRTINF
	BYT ' READY? '+128
	JSR GETKEY
	SEC
	BEQ TPWAI3	SKIP, IF ESCAPE
*
	CMP =$D
	BNE *-8		CONTINUE WAITING
	CLC
*
TPWAI3	RTS
*
*
	END
*
