TITLE CASSETTE SUBSYSTEM FOR SYSTEM MONITOR
;
;  ****Donated to the Pascal/Z80 Users Group, July 1980*****
;
;	A CASSETTE SUBSYSTEM FOR SYSTEM MONITOR
;	IT CONTROLS THE DAJEN/TELETEK UCRI. INCLUDES
;	ZAPPLE COMPATABLE {RI} AND {PO} INTERTIE
;
;	MODIFIED FOR C-MACRO ASSEMBLER MAY 1979 
;
;
;	CONSOLE BASE ADDRESS AND CASSETTE WORK AREA BASE
;
;	CBASE IS CONSOLE BASE ADDRESS
;	TWBASE IS CASSETTE VARIABLE BASE
;
;CASSETTE PORTS
;
IOBASE	EQU	060H		;PORT BASE
PORTC	EQU	0CH+IOBASE	;FILL OUTPUT PORT
PORTD	EQU	0DH+IOBASE	;STATUS PORT
PORTE	EQU	0EH+IOBASE	;LEVEL & RELAY PORT
PORTF	EQU	0FH+IOBASE	;DATA I/O PORT
;
;	CONSOLE CALL ADDRESSES
;
CCALL1	EQU	CBASE+9
CCALL2	EQU	CBASE+21H
;
;ENTRIES
;
TBASE	EQU	$
TNTRY0	JP	TINIT	;INITIALIZE THE PACKAGE
TNTRY1	JP	SVASC	;ZAPPLE {PO} WRITE CASSETTE
TNTRY2	JP	LDASC	;ZAPPLE {RI} READ CASSETTE
TNTRY3	JP	TWRITE	;SPHINX-DAJEN WRITE CASSETTE
TNTRY4	JP	TREAD	;SPHINX-DAJEN READ CASSETTE
TNTRY5	JP	OPENOUT ;CORE OPEN CASSETTE OUT-FILE
TNTRY6	JP	CTOUT	;CORE WRITE CASSETTE
TNTRY7	JP	CLOUT	;CORE CLOSE CASSETTE OUT-FILE
TNTRY8	JP	OPENIN	;CORE OPEN CASSETTE INP-FILE
TNTRY9	JP	CTINP	;CORE READ CASSETTE
TNTRYA	JP	CLINP	;CORE CLOSE CASSETTE INP-FILE
;
;EXTERNAL CALL VECTORS TO CONSOLE I.0
;
TKEYIN	JP	CCALL1	;UNSTROBED KEYBOARD CALL
TBFOUT	JP	CCALL2	;BUFFOUT MESSAGE CALL
;
;WORK AREA OF CASSETTE PACKAGE
;
TWRK	DEFW	TWBASE
;
;	INITIALIZE THE PACKAGE
;
TINIT	CALL	TSETUP
	LD	A,0E6H
	LD	(IY),A
	CALL	TERROR
	OR	A
	JP	TEXIT
;
;	SAVE IY REG .. USED IN CASSETTE PACKAGE
;
TSETUP	EX	(SP),IY
	PUSH	IY
	LD	IY,(TWRK)
	RET
;
;	EXIT FORM CASSETTE PACKAGE
;
TEXIT	POP	IY
	RET
;
;	ERROR RETURN
;
POPERR	POP	HL
ERROUT	LD	HL,TMSG1
	CALL	TBFOUT
	JR	TEXIT
;
;	COMPLETE RETURN
;
TDONE	LD	HL,TMSG2
	CALL	TBFOUT
	JR	TEXIT
;
;	CHECKSUM ERROR RETURN
;
CKSMER	LD	HL,TMSG3
	CALL	TBFOUT
	JR	TEXIT
;
;	TEST FOR ESCAPE
;
GETOUT	CALL	TKEYIN
	CP	1BH
	JR	Z,ESC1
	OR	A
	RET
ESC1	SCF
	RET
;
;CORE ROUTINES TO DRIVE THE DAJEN UCRI
;
;
;	INPUT A BYTE TO CASSETTE
;
CTINP:	CALL	GETOUT	;CK ESCAPE
	JR	Z,CTI1	;ESCAPE
	IN	A,(PORTE)
	AND	10H	;READY?
	JR	NZ,CTINP ;NO
	IN	A,(PORTF);YES  GET BYTE
	OR	A
	RET		;NORMAL RETURN
CTI1:	SCF		;ESCAPE RETURN
	RET
;
;	OUTPUT A BYTE TO CASSETTE
;
CTOUT:	PUSH	AF	;SAVE BYTE TEMP.
CTO1:	CALL	GETOUT	;ESCAPE?
	JR	Z,CTO2	;YES
	IN	A,(PORTD)
	AND	01H	;READY?
	JR	Z,CTO1	;NO
	POP	AF	;YES, GET BYTE
	OUT	(PORTF),A
	OR	A
	RET		;NORMAL RETURN
CTO2:	POP	AF
	SCF
	RET		;ESCAPE RETURN
;
;	DELAY ROUTINES
;
DELAY:	PUSH HL
	LD	HL,0H
DL1:	CALL	GETOUT
	JR	Z,DL5
DL2:	INC	H
	JR	Z,DL4
DL3:	INC	L
	JR	NZ,DL3
	JR	DL1
DL4:	OR	A
	POP	HL
	RET		;NORMAL RETURN
DL5:	SCF
	POP	HL
	RET		;ESCAPE RETURN
;
DELAY3: CALL	DELAY
	RET C
;
DELAY2: CALL	DELAY
	RET C
	CALL	DELAY
	RET
;
;	OPEN CASSETTE INPUT FILE
;	LOOK FOR SYNC BYTE THEN RET
;
OPENIN	CALL	TSETUP
	CALL	OPINP
	JP	TEXIT
;
OPINP:	PUSH	HL
	LD	HL,TMSG4
	CALL	TBFOUT
	LD	A,28H	;START CASSETTE
	OUT	(PORTE),A
OPI1:	CALL	GETOUT	;ESCAPE?
	JR	Z,OPI2	;YES
	IN	A,(PORTE)
	AND	40H	;LEVEL OK?
	JR	Z,OPI1	;NO
	CALL	DELAY	;YES, WAIT A WHILE
	JR	C,OPI3	;ESCAPE
	IN	A,(PORTE)	
	AND	40H	;LEVEL STILL OK?
	JR	Z,OPINP ;NO, RESTART
	CALL	DELAY	;YES, WAIT SOME MORE
	JR	C,OPI3	;ESCAPE
	LD	A,(IY);LOAD SYNC BYTE
	OUT	(PORTD),A
	LD	HL,TMSG5 ;NORMAL RETURN
	CALL	TBFOUT
	OR	A
	JR	OPI3
OPI2:	SCF		;ESCAPE RETURN
OPI3:	POP	HL
	RET
;
;	OPEN CASSETTE OUTPUT FILE
;	OUTPUT A LEADER OF NULLS
;
OPENOUT CALL	TSETUP
	CALL	OPOUT
	JP	TEXIT
;
OPOUT:	PUSH	HL
	LD	HL,TMSG6
	CALL	TBFOUT
	POP	HL
	LD	A,28H	;INIT CASSETTE
	OUT	(PORTE),A
	OUT	(PORTD),A
	CALL	DELAY	;OUTPUT SILENT LEADER
	RET C		;ESCAPE
	SUB	A
	OUT	(PORTC),A
	CALL	DELAY3	;OUTPUT FILL TONE
	RET C		;ESCAPE
	CALL	DELAY3
	RET C		;ESCAPE
	CALL	DELAY3
	RET C		;ESCAPE
	LD	A,3CH	;OUTPUT CLOCK BYTE
	CALL	CTOUT
	RET C		;ESCAPE
	LD	A,(IY);OUTPUT SYNC BYTE
	CALL	CTOUT
	RET C		;ESCAPE
	OR	A
	RET		;NORMAL RETURN
;
;	CLOSE CASSETTE INPUT AND OUTPUT FILES
;		OUT - OUTPUT A TRAILER OF NULLS
;		INP - MOVE ONTO THE TRIAULER 
;		TURN OFF CASSETTE ALSO
;
CLOUT:	SUB	A	;OUTPUT TRAILER TONE
	CALL	CTOUT
	RET C		;ESCAPE
	CALL	DELAY
	RET C
OFFCAS: LD	A,28H	;OUTPUT SILENT TONE
	OUT	(PORTE),A
	OUT	(PORTD),A
CLINP:	CALL	DELAY	;INP ENTRY
	RET C		;ESCAPE
	LD	A,38H	;TURN OFF CASSETE
	OUT	(PORTE),A
	OR	A
	RET		;NORMAL RETURN
;
;	ESCAPE RETURN
;
TERROR	CALL	OFFCAS
	LD	A,02H
	LD	(IY+1),A
	SCF		;SET CARRY FLAG
	RET
;
;	DAJEN OUTPUT TO CASSETTE ROUTINE
;	TARBELL COMPATABLE W/CKSUM
;
TWRITE	CALL	TSETUP
	EX	DE,HL
	LD	B,0
	CALL	OPOUT	;OPEN FILE
	JP	C,ERROUT
	LD	A,E	;SEND STARTING ADDRESS
	CALL	DJCO
	JP	C,ERROUT
	LD	A,D
	CALL	DJCO
	JP	C,ERROUT
	LD	A,H	;SEND NUMBER OF BYTES
	CALL	DJCO
	JP	C,ERROUT
	LD	A,L
	CALL	DJCO
	JP	C,ERROUT
DJ1:	LD	A,(DE)	;SEND A BYTE
	CALL	DJCO
	JP	C,ERROUT
	INC	DE
	DEC	HL
	SUB	A
	OR	H
	OR	L
	JR	NZ,DJ1
	LD	A,B	;SEND CKSUM
	CALL	DJCO
	JP	C,ERROUT
	CALL	CLOUT	;CLOSE FILE
	JP	C,ERROUT
	JP	TDONE
;
;	DAJEN INPUT CASSETTES ROUTINE
;	3 OPTIONS AVAILABLE
;		I(CR)		STANDARD LOAD
;		IBBBB(CR)	STD.LD W/BIAS
;		IXXXX,YYYY(CR)	LOAD SPECIFIC
;				WHERE X,Y ARE BEG
;				AND END. ADDR.
;
TREAD	CALL	TSETUP
	OR	A
	JR	Z,TRD1
;
;	LOAD SPECIFIC FROM ADDR1 TO ADDR2
;
	EX	DE,HL
	CALL	OPINP	;OPEN FILE
	JP	C,ERROUT
	CALL	DJ4	;LOAD IN FILE
	CALL	CLINP	;CLOSE FILE	
	JP	C,ERROUT
	JP	TDONE
;
;	LOAD ABSOLUTE AS DIRECTED ON TAPE
;	WITH A BIAS RESIDING IN REG HL
;
TRD1	CALL	OPINP	;OPEN FILE
	JP	C,ERROUT
	LD	B,0	;INITIALIZE CKSUM
	CALL	DJCI	;GET STARTING ADDR
	JP	C,ERROUT
	LD	E,A
	CALL	DJCI
	JP	C,ERROUT
	LD	D,A
	ADD	HL,DE	;ADD ON BIAS
	EX	DE,HL
	CALL	DJCI	;GET NO. OF BYTES
	JP	C,ERROUT
	LD	H,A
	CALL	DJCI
	JP	C,ERROUT
	LD	L,A
	CALL	DJ4	;LOAD IN FILE
	CALL	CTINP	;GET CKSUM
	CP	B
	PUSH	AF
	CALL	CLINP	;CLOSE FILE
	JP	C,POPERR
	POP	AF
	JP	NZ,CKSMER
	JP	TDONE
DJ4:	CALL	DJCI	;LOAD IN FILE
	JP	C,POPERR
	LD	(DE),A
	INC	DE
	DEC	HL
	LD	A,H
	OR	L
	JR	NZ,DJ4
	RET
DJCI:	CALL	CTINP	;GET BYTE
	RET C
	PUSH	AF
	CALL	DJCK
	POP	AF
	RET
DJCO:	CALL	CTOUT	;SEND BYTE
	RET C
DJCK	ADD	A,B
	LD	B,A	
	OR	A
	RET
	EJECT
;
;	CASSETTE ROUTINES FOR ZAPPLE BASIC
;	ENTRY THOUGH THE MONITOR
;	WRITTEN BY RICHARD LERSETH AUG 15, 1978
;
;	CHECK FOR {FFH} IN PRES AND LAST BYTE
;
CKFF:	INC	A	;PRES FF?
	LD	A,(IY+2)
	JR	Z,CK3	;YES
	INC	A	;LAST FF?
	JR	Z,CK1	;YES
	SUB	A	; <>   <>
	INC	A
	RET
CK1	INC	A	; <>   =	   
CK2	SCF		; =    =
	RET
CK3	INC	A	;LAST FF?
	JR	Z,CK2	;YES
	SUB	A	; =    <>
	RET
;
;	CHECK FOR END OF FILE
;
CKEND:	LD	A,(IY+3)
	INC	A
	LD	(IY+3),A
	CP	08H
	JR	NZ,CKE1
	LD	A,(IY+4)
	OR	A
	JR	NZ,CKE1
	SCF
	RET
CKE1	SUB	A
	RET
;
;	RESET FLAG AND COUNTER
;
RESET:	SUB	A
	LD	(IY+3),A
	LD	(IY+4),A
	RET
;
;	OUTPUT TO CASSETTE
;
SVASC	CALL	TSETUP
	CALL	SAVE
	JP	TEXIT
;
SAVE	LD	A,(IY+1)	;TRANS MODE?
	OR	A
	JR	NZ,SVFORE
	LD	A,C
	CALL	CTOUT
	JP	C,TERROR
	CALL	CKFF
	LD	A,C
	LD	(IY+2),A
	JR	Z,AS1
	CALL	C,RESET
	RET
AS1	CALL	CKEND
	JR	C,SVAFT
	RET
;
SVFORE: LD	A,C
	INC	A
	JP	NZ,TERROR
	CALL	OPOUT
	JP	C,TERROR
	LD	A,C
	LD	(IY+2),A
	CALL	CTOUT
	JP	C,TERROR
	SUB	A
	LD	(IY+3),A
	LD	(IY+1),A
	INC	A
	LD	(IY+4),A
	RET
;
SVAFT:	CALL	CLOUT
	JP	C,TERROR
	LD	A,2
	LD	(IY+1),A
	RET
;
;	INPUT FROM CASSETTE
;
LDASC	CALL	TSETUP
	CALL	LOAD
	JP	TEXIT
;
LOAD	LD	A,(IY+1)
	DEC	A
	JR	NZ,LDFORE
	CALL	CTINP
	JP	C,TERROR
	PUSH	AF
	CALL	CKFF
	JR	Z,AL1
	CALL	C,RESET
	POP	AF
	RET
;
AL1	CALL	CKEND
	JR	C, LDAFT
	POP	AF
	RET
;
LDFORE: CALL	OPINP
	JP	C,TERROR
	SUB	A
	LD	(IY+3),A
	INC	A
	LD	(IY+1),A
	CALL	CTINP
	JP	C,TERROR
	LD	(IY+2),A
	RET
;
LDAFT:	CALL	CLINP
	JR	NC,LD1
	POP	AF
	JP	TERROR
LD1	POP	AF
	RET
;
;PACKAGE MESSAGES
CR	DEFL	0DH
LF	DEFL	0AH
EOM	DEFL	00H
;
TMSG1	DEFB	CR,LF,'ESCAPE',EOM
TMSG2	DEFB	CR,LF,'COMPLETE',EOM
TMSG3	DEFB	CR,LF,'CHECKSUM ERROR',EOM
TMSG4	DEFB	CR,LF,'>SEARCHING ',EOM
TMSG5	DEFB	'* READING',EOM
TMSG6	DEFB	CR,LF,'>WRITING ',EOM