;---> Originally from the CPMUG volume 15
;
;TSAVE V.4 - TARBELL SAVE 
;BY WARD CHRISTENSEN
;WORKS FOR ANY CP/M FILE
;01/15/77 ORIGINALLY WRITTEN
;08/01/77 ADD CHECKSUM
;09/19/77 ADD DELAY BEFORE WRITING TO
;	  ALLOW TIME FOR MULTIPLE TLOADS
;	  VIA 'SUBMIT' COMMAND
;
;04/10/81 CORRECTED BUG IN EXIT ROUTINE THAT PREVENTED
;USE OF SUBMIT FILES - R.M.GLUECK
;
;WRITES 11 CHAR FILENAME,
;	1 BYTE # SECTORS,
;	DATA, (TYPICALLY 4K BLOCKS)
;	CHECKSUM
;
;IF 'TSAVE FN.FT ?' IS TYPED, CHECKS THE TAPE
;	BY READING IT BACK
NSEC	EQU	32	;NUMBER OF SECTORS/BLOCK
SECDLY	EQU	4	;# SECONDS DELAY 
			;BEFORE EACH WRITE
	ORG	100H	;TO TPA
	CALL	START	;SKIP ID
ID	DB	'Tarbell Save of 04/10/81 ',0DH,0AH,'$'
START	POP	D	;GET ID MSG ADDR
	MVI	C,PRINT
	CALL	BDOS	;PRINT ID
;INIT PRIVATE STACK
	LXI	H,0
	DAD	SP
	SHLD	STACK
	LXI	SP,STACK	
;SAVE THE '?' FROM 'TSAVE FN.FT ?'
	LDA	FCB+17	;LOAD THE '?'
	STA	CHECK	;SAVE
;OPEN FILE
	LXI	D,FCB
	MVI	C,OPEN
	CALL	BDOS
	INR	A	;OPEN OK?
	JZ	OPNER
;WRITE 'AUDIO HEADER' ONTO THE TAPE
	LDA	CHECK	;CHECKING?
	CPI	'?'
	JZ	READB	;SKIP HDR IF CHECKING
	MVI	B,0	;>1 SECONDS WORTH
AUDIOH	MVI	A,11H	;GET DISTINCTIVE PATTERN
	CALL	TOUT	;OUTPUT IT
	DCR	B
	JNZ	AUDIOH
;
;READ FILE, WRITE TARBELL 
;	IN NSEC SECTOR (4K) BLOCKS
READB	MVI	E,'*'	;PRINT '*' EVERY BLOCK WRITTEN
	MVI	C,WRCON 
;PRINT '?' IF CHECKING, OTHERWISE '*'
	LDA	CHECK
	CPI	'?'	;CHECKING?
	JNZ	PRAST	;NO, PRINT ASTERISK
	MOV	E,A	;MOVE SO '?' PRINTS
PRAST	CALL	BDOS	;PRINT '?' OR '*'
RDLP	LHLD	BUFAD	;GET BUFFER ADDR
	XCHG		;MOVE TO D,E
;SET NEW BUFFER ADDR
	LXI	H,128	;GET BUFFER LENGTH
	DAD	D	;POINT TO NEXT
	SHLD	BUFAD
	MVI	C,STDMA	;SET
	CALL	BDOS	;..DMA ADDR
	LHLD	BUFAD
	LXI	D,FCB
	MVI	C,READ
	CALL	BDOS
	ORA	A	;READ OK?
	JNZ	RDER	;NO, CHECK EOF
;INCR BUFF COUNT, IF NSEC, WRITE
	LDA	BUFFN
	INR	A
	STA	BUFFN
	CPI	NSEC
	JC	RDLP	;LOOP IF MORE TO DO
;HAVE READ NSEC SECTORS, WRITE THEM
EOFWR	LDA	CHECK	;WAS TSAVE ? REQUESTED?
	CPI	'?'
	JNZ	NCK1	;NO - INIT FOR OUTPUT
;INIT TARBELL FOR INPUT
	MVI	A,10H	;GET INPUT RESET CHAR
	OUT	6EH	;RESET TARBELL
	JMP	SENDF	;SKIP OUTPUT INIT
;CHECK NOT REQUESTED - INIT TARBELL OUTPUT
NCK1	MVI	A,3CH	;START BYTE
	CALL	TOUT
	MVI	A,0E6H	;GET TARBELL SYNCH CHAR
	CALL	TOUT	;OUTPUT IT
SENDF	LXI	H,FCB+1	;SET UP AND
	MVI	B,8+3	;..OUTPUT
FCBLP	MOV	A,M	;GET FCB CHAR
	CALL	TOUT	;WRITE IT
	INX	H	;POINT TO NEXT
	DCR	B	;MORE?
	JNZ	FCBLP
;WRITE THE SECTOR COUNT
	LDA	BUFFN	;GET SECTOR COUNT
	CALL	TOUT	;WRITE IT
;IF BUFFN IS 0, THEN THAT WAS EOF
	LDA	BUFFN
	ORA	A	;DONE?
	JZ	DONE	;YES
;WRITE THE SECTORS
	LXI	H,BUFF	;POINT TO START
	SHLD	BUFAD	;INIT BUFF ADDR
	LDA	BUFFN	;GET NUMBER OF BUFFERS
	MOV	B,A	;SAVE IN B
	XRA	A	;GET A ZERO
	STA	CKSUM	;INIT CKSUM
WRSEC	MVI	C,128	;INIT C TO SECTOR LENGTH
WRCHR	MOV	A,M	;GET CHAR
	CALL	TOUT	;WRITE IT
	INX	H	;POINT TO NEXT
	DCR	C	;MORE IN SECTOR?
	JNZ	WRCHR
	DCR	B	;DECR # OF SECTORS
	JNZ	WRSEC	;MORE SECTORS TO WRITE
	LDA	CKSUM	;SEND CKSUM
	CALL	TOUT
	XRA	A	;GET A ZERO
	STA	BUFFN	;INIT BUFF NUMBER
;SEND DELAY BYTES
	CALL	DELAY
;IF EOF, SEND EOF REC (HDR, 0 DATA)
	LDA	EOFLG	;GET FLAG
	ORA	A	;EOF?
	JNZ	EOFWR	;YES
	JMP	READB	;GO READ MORE
;READ ERROR - CHECK FOR EOF
RDER	DCR	A	;WAS IT 1?
	JNZ	RDERR	;NO, GENUINE READ ERROR
;EOF REACHED
	INR	A	;GET NON-ZERO VALUE
	STA	EOFLG	;SET EOF FLAG
	JMP	EOFWR	;GO WRITE LAST PART
;ALL DONE - WRITE 2 X DELAYS
DONE	CALL	DELAY
	CALL	DELAY
	JMP	EXIT
OPNER	LXI	D,MSG2
	JMP	ERXIT
RDERR	LXI	D,MSG5	;READ ERROR 
	JMP	ERXIT
ERXIT	MVI	C,PRINT
	CALL	BDOS	;PRINT MESSAGE
EXIT	LHLD	STACK	;GET ORIGINAL STACK
	SPHL		;RESTORE IT
	JMP	0	;(WAS RET -  4/10/81 RMG)
;TARBELL WRITE
TOUT	PUSH	PSW
;CALC CKSUM
	PUSH	H
	LXI	H,CKSUM
	XRA	M	;CALC CKSUM
	MOV	M,A	;SAVE IT BACK
	POP	H
;IF CHECKING, THEN READ AND MATCH
	LDA	CHECK
	CPI	'?'
	JZ	RDCK	;READ, CHECK
TWAIT	IN	6EH
	ANI	20H
	JNZ	TWAIT
	POP	PSW
	OUT	6FH
	RET
RDCK	POP	PSW	;GET CHAR
	PUSH	B	;SAVE BC
	MOV	B,A	;PUT CHAR IN B
RDWT	IN	6EH	;READ TARBELL STAT
	ANI	10H
	JNZ	RDWT
	IN	6FH
	CMP	B
	JZ	CKOK	;CHAR MATCHED
;CHAR DIDN'T MATCH -
 	LXI	D,CKERR	;GET ERR MSG
	JMP	ERXIT	;PRINT ERROR, EXIT
CKOK	POP	B	;RESTORE BC
	RET
;TIME DELAY ROUTINE - WAITS 'SECDLY' SECONDS
DELAY	LDA	CHECK	;DON'T DELAY
	CPI	'?'	;..IF CHECKING
	RZ		;RET - CHECKING
	LXI	B,187*SECDLY ;GET SECONDS
DELAY2	MVI	A,3CH	;TARBELL START CHAR
	CALL	TOUT
	DCX	B	;DONE?
	MOV	A,B
	ORA	C	;BC=0?
	JNZ	DELAY2
	RET
	DS	30	;STACK AREA
STACK	DS	2	;STACK POINTER
MSG2	DB	'CANNOT OPEN$'
MSG5	DB	'READ ERR$'
CKERR	DB	'COMPARE UNEQUAL$'
BLKNO	DB	0	;BLOCKS READ, TO BE WRITTEN
BUFFN	DB	0	;BUFFER NUMBER
CHECK	DS	1	;IF TSAVE ? TYPED
CKSUM	DS	1	;CHECKSUM
EOFLG	DB	0	;EOF FLAG, 0=NO
BUFAD	DW	BUFF	;CURRENT READ ADDR
BUFF	EQU	$	;BUFFER FROM HERE ON
;
; BDOS EQUATES (VERSION 2)
;
RDCON	EQU	1
WRCON	EQU	2
PRINT	EQU	9
OPEN	EQU	15	;0FFH=NOT FOUND
CLOSE	EQU	16	;   "	"
SRCHF	EQU	17	;   "	"
SRCHN	EQU	18	;   "	"
ERASE	EQU	19	;NO RET CODE
READ	EQU	20	;0=OK, 1=EOF
WRITE	EQU	21	;0=OK, 1=ERR, 2=?, 0FFH=NO DIR SPC
MAKE	EQU	22	;0FFH=BAD
REN	EQU	23	;0FFH=BAD
STDMA	EQU	26
BDOS	EQU	5
REIPL	EQU	0
FCB	EQU	5CH	;SYSTEM FCB