;TARBELL LOAD - LOADS TAPES
;SAVED WITH TSAVE COMMAND
;
;FORMAT IS:	TLOAD FN1.FT1
;	OR:	TLOAD FN1.FT1 FN2.FT2
;
;FN1.FT1 IS THE NAME OF THE FILE TO BE CREATED ON DISK,
;FN2.FT2 IS THE NAME THE FILE WAS TSAVED UNDER, IF
;DIFFERENT THAN FN1.FT1
;
FCB	EQU	5CH	;SYSTEM FCB
	ORG	100H	;TO TPA
	CALL	START	;SKIP ID
ID	DB	'(TLOAD 8/1/77)',0DH,0AH,'$'
START	POP	D	;GET ID MSG
	MVI	C,PRINT
	CALL	BDOS	;PRINT ID
;INIT PRIVATE STACK
	LXI	H,0	;HL=0
	DAD	SP	;HL=CCP'S STACK
	SHLD	STACK	;SAVE CCP'S STACK POINTER
	LXI	SP,STACK ;GET LOCAL STACK
;ERASE FN1.OLD IF IT EXISTS
	LXI	H,FCB	;POINT TO FCB
	LXI	D,MYFCB ;AND TO MY FCB
	MVI	B,9	;MOVE LENGTH
	CALL	MOVE	;MOVE FILENAME TO MYFCB
	LXI	D,MYFCB	;POINT TO FN1.OLD FCB
	MVI	C,DELT	;DELETE FUNCTION
	CALL	BDOS	;DELETE FN1.OLD, IGNORE ERRS
;SAVE FN1.FT1 OR FN2.FT2 FOR TAPE HEADER MATCH
	LXI	H,FCB+1	;GET FN1.FT1 POINTER
	LXI	D,TAPEN	;POINT DE TO SAVE NAME AREA
	MVI	B,11	;NAME LENGTH
	LDA	FCB+17	;IS FM2.FT2 BLANK?
	CPI	' '
	JZ	MOVEN	;YES, SAVE FN1.FT1
;SECOND NAME HAS BEEN SPECIFIED
	LXI	H,FCB+17 ;POINT TO FN2.FT2
MOVEN	CALL	MOVE	;SAVE THE TAPE NAME
;
;IF IT EXISTS, RENAME FN1.FT1 TO FN1.OLD
;
	LXI	H,MYFCB	;POINT TO FN1.OLD
	LXI	D,FCB+16	;POINT TO SYSFCB+16
	MVI	B,16	;INIT MOVE LENGTH
	CALL	MOVE	;SET UP FOR
	LXI	D,FCB	;RENAME
	MVI	C,REN	;FUNCTION, THEN
	CALL	BDOS	;DO THE RENAME,
			;IGNORE ERRORS.
;
;MAKE FN1.FT1 A NEW FILE
;
	LXI	D,FCB	;POINT TO FCB
	MVI	C,MAKE	;C=MAKE FUNCTION
	CALL	BDOS	;MAKE THE FILE
	INR	A	;SPACE IN DIRECTORY?
	JNZ	DIROK	;YES
;
;NO DIRECTORY SPACE - PRINT ERROR, EXIT
;
	LXI	D,NODIR	;POINT TO ERR MSG
ERXIT	MVI	C,PRINT	;GET PRINT FUNCTION
	CALL	BDOS	;PRINT ERROR MESSAVGE
EXIT	LHLD	STACK	;GET CCP'S STACK
	SPHL		;RESTORE STACK
	RET		;RETURN TO CCP
;
;MAKE WAS SUCCESSFUL - OPEN FILE
;
DIROK	LXI	D,FCB	;POINT TO FCB
	MVI	C,OPEN	;GET 'OPEN' FUNCTION
	CALL	BDOS	;OPEN THE FILE
	INR	A	;SHOULD BE OK
	JNZ	RDLP	;OPEN WAS OK
;
;OPEN FAILED - EXIT
;
	LXI	D,OPNER	;POINT TO ERR MSG
	JMP	ERXIT	;PRINT MSG, EXIT
;
;OPEN WAS OK - START READING
;
RDLP	EQU	$	;READ LOOP
	MVI	A,10H	;GET TARBELL RESET CHAR
	OUT	6EH	;RESET TARBELL
;
;READ THE TAPE HEADER
;
	MVI	B,11	;# OF CHARS TO MATCH
	LXI	H,TAPEN	 ;POINT TO NAME TO MATCH
	LXI	D,73B0H	;'POKE' VDM ADDR TO SHOW NAME
HEADR	CALL	TBIN	;READ CHAR
	STAX	D	;POKE NAME ON VDM
	CMP	M	;MATCH?
	JZ	MATCH	;YES
;
;NO MATCH - TRY AGAIN
;
	JMP	RDLP
;
;HEADER CHAR MATCHED, SEE IF DONE
;
MATCH	INX	D	;POINT TO NEXT CHAR
	INX	H	;POINT TO NEXT CHAR
	DCR	B	;11 MATCHED?
	JNZ	HEADR	;NO
;
;GOT HEADER MATCH, START READING
;
	LXI	H,BUFF	;POINT TO BUFFER
	CALL	TBIN	;READ THE NUMBER OF SECTORS
	STA	NSEC	;SAVE NUMBER OF SECTORS
	MOV	B,A	;SAVE IN B
	ORA	A	;ZERO SECTORS (I.E. EOF)?
	JZ	EOF	;YES, EOF
	XRA	A
	STA	CKSUM	;INIT CKSUM TO 0
SECT	MVI	C,128	;C=BYTES/SECTOR
CHAR	CALL	TBIN	;READ A CHAR
	MOV	M,A	;STORE IT
	INX	H	;INCR BUFF POINTER
	DCR	C	;MORE IN SECTOR?
	JNZ	CHAR	;YES
	DCR	B	;MORE SECTORS?
	JNZ	SECT	;YES
;VERIFY CKSUM
	CALL	TBIN	;READ CKSUM
	LDA	CKSUM
	ORA	A
	JZ	NOCKS
;GOT CHECKSUM ERR
	LXI	D,CSERM
	MVI	C,PRINT
	CALL	BDOS
;
;HAVE READ 1 BUFFER FULL, WRITE IT TO DISK
;
NOCKS	LXI	H,BUFF	;GET BUFF ADDR
	SHLD	BUFAD	;INIT 'WRITE FROM' ADDR
WRLP	LHLD	BUFAD	;GET CURRENT BUFF ADDR
	XCHG		;MOVE TO D,E
	LXI	H,128	;HL=BUFF LENGTH
	DAD	D	;POINT TO NEXT BUFFER
	SHLD	BUFAD	;UPDATE BUFF ADDR
	MVI	C,STDMA	;SET UP DMA
	CALL	BDOS	;..ADDR
	LXI	D,FCB	;WRITE
	MVI	C,WRITE	;..A
	CALL	BDOS	;..SECTOR
	ORA	A	;CHECK STATUS
	JZ	WROK	;WRITE WAS OK
;
;WRITE ERROR
;
	ADI	'0'	;GET ERROR NUMBER FROM STAT
	STA	WRERN	;SAVE ERROR #
	LXI	D,WRERR	;GET MESSAGE ADDR
	JMP	ERXIT	;PRINT MESSAGE, EXIT
WROK	LDA	NSEC	;ARE WE
	DCR	A	;..DONE
	STA	NSEC	;..WRITING THIS SECTOR?
	JNZ	WRLP	;NO
	JMP	RDLP	;YES, READ NEXT BUFFER
;
;EOF REACHED - CLOSE FILE
;
EOF	LXI	D,FCB
	MVI	C,CLOSE
	CALL	BDOS
	INR	A	;CLOSE OK?
	JNZ	EXIT	;YES, RETURN
;CLOSE ERROR
	LXI	D,CLSER
	JMP	ERXIT
OPNER	DB	'OPEN FAILED$'
NODIR	DB	'NO DIR. SPACE$'
WRERR	DB	'WRITE ERR '
WRERN	DB	0,'$'
CSERM	DB	'CKSUM',13,10,'$' 
CLSER	DB	'CLOSE ERR$'
;MOVE ROUTINE, FROM HL TO DE FOR LENGTH IN B
MOVE	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	MOVE
	RET
;TARBELL INPUT ROUTINE
TBIN	IN	6EH
	ANI	10H
	JNZ	TBIN
	IN	6FH
;CALC CKSUM
	PUSH	H
	LXI	H,CKSUM
	PUSH	PSW	;SAVE CHAR
	XRA	M	;CALC CKSUM
	MOV	M,A	;SAVE CKSUM
	POP	PSW
	POP	H
	RET
	DS	30	;STACK SPACE
STACK	DS	2	;SAVE STACK POINTER HERE
TAPEN	DS	11	;TAPE SAVE NAME
MYFCB	DS	9	;0,FILENAME
	DB	'OLD'	;FOR DELETE, RENAME
	DB	0
	DS	20	;END OF FCB
CKSUM	DS	1	;CHECKSUM 
NSEC	DS	1	;NUMBER OF SECTORS READ
BUFAD	DW	BUFF	;CURR DMA BUFF POINTER
BUFF	EQU	$	;START OF BUFFER
;
; 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	;   "	"
DELT	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
	END	100H