write

.PAG 'TAPE WRITE'
; CASSETTE INFO - FSBLK IS BLOCK COUNTER FOR RECORD
;       FSBLK = 2 -FIRST HEADER
;             = 1 -FIRST DATA
;             = 0 -SECOND DATA
;
; WRITE - TOGGLE WRITE BIT ACCORDING TO LSB IN OCHAR
;
WRITE	LDA OCHAR       ;SHIFT BIT TO WRITE INTO CARRY
	LSR A
	LDA #96         ;...C CLR WRITE SHORT
	BCC WRT1
WRTW	LDA #176        ;...C SET WRITE LONG
WRT1	LDX #0          ;SET AND STORE TIME
WRTX	STA D1T2L
	STX D1T2H
	LDA D1ICR       ;CLEAR IRQ
	LDA #$19        ;ENABLE TIMER (ONE-SHOT)
	STA D1CRB
	LDA R6510       ;TOGGLE WRITE BIT
	EOR #$08
	STA R6510
	AND #$08        ;LEAVE ONLY WRITE BIT
	RTS
;
WRTL3	SEC             ;FLAG PRP FOR END OF BLOCK
	ROR PRP
	BMI WRT3        ; JMP
;
; WRTN - CALLED AT THE END OF EACH BYTE
;   TO WRITE A LONG RER    REZ
;              HHHHHHLLLLLLHHHLLL...
;
WRTN	LDA RER         ;CHECK FOR ONE LONG
	BNE WRTN1
	LDA #16         ;WRITE A LONG BIT
	LDX #1
	JSR WRTX
	BNE WRT3
	INC RER
	LDA PRP         ;IF END OF BLOCK(BIT SET BY WRTL3)...
	BPL WRT3        ;...NO END CONTINUE
	JMP WRNC        ;...END ...FINISH OFF
;
WRTN1	LDA REZ         ;CHECK FOR A ONE BIT
	BNE WRTN2
	JSR WRTW
	BNE WRT3
	INC REZ
	BNE WRT3
;
WRTN2	JSR WRITE
	BNE WRT3        ;ON BIT LOW EXIT
	LDA FIRT        ;CHECK FOR FIRST OF DIPOLE
	EOR #1
	STA FIRT
	BEQ WRT2        ;DIPOLE DONE
	LDA OCHAR       ;FLIPS BIT FOR COMPLEMENTARY RIGHT
	EOR #1
	STA OCHAR
	AND #1          ;TOGGLE PARITY
	EOR PRTY
	STA PRTY
WRT3	JMP PREND       ;RESTORE REGS AND RTI EXIT
;
WRT2	LSR OCHAR       ;MOVE TO NEXT BIT
	DEC PCNTR       ;DEC COUNTER FOR # OF BITS
	LDA PCNTR       ;CHECK FOR 8 BITS SENT...
	BEQ WRT4        ;...IF YES MOVE IN PARITY
	BPL WRT3        ;...ELSE SEND REST
;
WRTS	JSR NEWCH       ;CLEAN UP COUNTERS
	CLI             ;ALLOW FOR INTERRUPTS TO NEST
	LDA CNTDN       ;ARE WE WRITING HEADER COUNTERS?...
	BEQ WRT6        ;...NO
; WRITE HEADER COUNTERS (9876543210 TO HELP WITH READ)
	LDX #0          ;CLEAR BCC
	STX DATA
WRTS1	DEC CNTDN
	LDX FSBLK       ;CHECK FOR FIRST BLOCK HEADER
	CPX #2
	BNE WRT61       ;...NO
	ORA #$80        ;...YES MARK FIRST BLOCK HEADER
WRT61	STA OCHAR       ;WRITE CHARACTERS IN HEADER
	BNE WRT3
;
WRT6	JSR CMPSTE      ;COMPARE START:END
	BCC WRT7        ;NOT DONE
	BNE WRTL3       ;GO MARK END
	INC SAH
	LDA DATA        ;WRITE OUT BCC
	STA OCHAR
	BCS WRT3        ;JMP
;
WRT7	LDY #0          ;GET NEXT CHARACTER
	LDA (SAL)Y
	STA OCHAR       ;STORE IN OUTPUT CHARACTER
	EOR DATA        ;UPDATE BCC
	STA DATA
	JSR INCSAL      ;INCREMENT FETCH ADDRESS
	BNE WRT3        ;BRANCH ALWAYS
;
WRT4	LDA PRTY        ;MOVE PARITY INTO OCHAR...
	EOR #1
	STA OCHAR       ;...TO BE WRITTEN AS NEXT BIT
WRTBK	JMP PREND       ;RESTORE REGS AND RTI EXIT
;
WRNC	DEC FSBLK       ;CHECK FOR END
	BNE WREND       ;...BLOCK ONLY
	JSR TNOF        ;...WRITE, SO TURN OFF MOTOR
WREND	LDA #80         ;PUT 80 CASSETTE SYNCS AT END
	STA SHCNL
	LDX #8
	SEI
	JSR BSIV        ;SET VECTOR TO WRITE ZEROS
	BNE WRTBK       ;JMP
;
WRTZ	LDA #120        ;WRITE LEADING ZEROS FOR SYNC
	JSR WRT1
	BNE WRTBK
	DEC SHCNL       ;CHECK IF DONE WITH LOW SYNC...
	BNE WRTBK       ;...NO
	JSR NEWCH       ;...YES CLEAR UP COUNTERS
	DEC SHCNH       ;CHECK IF DONE WITH SYNC...
	BPL WRTBK       ;...NO
	LDX #10         ;...YES SO SET VECTOR FOR DATA
	JSR BSIV
	CLI
	INC SHCNH       ;ZERO SHCNH
	LDA FSBLK       ;IF DONE THEN...
	BEQ STKY        ;...GOTO SYSTEM RESTORE
	JSR RD300
	LDX #9          ;SET UP FOR HEADER COUNT
	STX CNTDN
	STX PRP         ;CLEAR ENDOF BLOCK FLAG
	BNE WRTS        ;JMP
;
TNIF	PHP             ;CLEAN UP INTERRUPTS AND RESTORE PIA'S
	SEI
	LDA VICREG+17   ;UNLOCK VIC
	ORA #$10        ;ENABLE DISPLAY
	STA VICREG+17
	JSR TNOF        ;TURN OFF MOTOR
	LDA #$7F        ;CLEAR INTERRUPTS
	STA D1ICR
	JSR IOKEYS      ;RESTORE KEYBOARD IRQ FROM TIMMER1
	LDA IRQTMP+1    ;RESTORE KEYBOARD INTERRUPT VECTOR
	BEQ TNIQ        ;NO IRQ (IRQ VECTOR CANNOT BE Z-PAGE)
	STA CINV+1
	LDA IRQTMP
	STA CINV
TNIQ	PLP
	RTS
;
STKY	JSR TNIF        ;GO RESTORE SYSTEM INTERRUPTS
	BEQ WRTBK       ;CAME FOR CASSETTE IRQ SO RTI
;
; BSIV - SUBROUTINE TO CHANGE IRQ VECTORS
;  ENTRYS - .X = 8 WRITE ZEROS TO TAPE
;           .X = 10 WRITE DATA TO TAPE
;           .X = 12 RESTORE TO KEYSCAN
;           .X = 14 READ DATA FROM TAPE
;
BSIV	LDA BSIT-8,X    ;MOVE IRQ VECTORS, TABLE TO INDIRECT
	STA CINV
	LDA BSIT+1-8,X
	STA CINV+1
	RTS
;
TNOF	LDA R6510       ;TURN OFF CASSETTE MOTOR
	ORA #$20        ;
	STA R6510
	RTS
.SKI 3
;COMPARE START AND END LOAD/SAVE
;ADDRESSES.  SUBROUTINE CALLED BY
;TAPE READ, SAVE, TAPE WRITE
;
CMPSTE	SEC
	LDA SAL
	SBC EAL
	LDA SAH
	SBC EAH
	RTS
.SKI 3
;INCREMENT ADDRESS POINTER SAL
;
INCSAL	INC SAL
	BNE INCR
	INC SAH
INCR	RTS
.END
; RSR 7/28/80 ADD COMMENTS
; RSR 8/4/80 CHANGED I/O FOR VIXEN
; RSR 8/21/80 CHANGED I/O FOR VIXEN MOD
; RSR 8/25/80 CHANGED I/O FOR VIXEN MOD2
; RSR 12/11/81 MODIFY I/O FOR VIC-40
; RSR 2/9/82 ADD VIC TURN ON, REPLACE SAH WITH PRP