;BLOAD - 
;PROGRAM TO READ TARBELL 8K BASIC 3.1 TAPES
;AND CREATE A SOURCE FILE
TEST	EQU	0H
;5/17/77 WRITTEN
	ORG	100H
	JMP	START	;SKIP ID
	DB	'(BLOAD 5/17/77)','Z'-40H
START	EQU	$
;
	IF	NOT TEST
	MVI	C,DELT
	CALL	DKFNC	;ERASE OLD FILE
	MVI	C,MAKE
	CALL	DKFNC
	INR	A
	JZ	WRERR
	ENDIF
;
	LXI	H,BUFF
;READ FILE INTO MEMORY FROM TAPE
RESET	MVI	A,10H
	OUT	6EH
INIT	CALL	TBIN
	CPI	0E6H
	JZ	INIT	;SKIP DOUBLE SYNC
	STA	7300H	;SHOW CHAR BEING LOADED
RD3	MVI	D,3
RDLP	CALL	TBIN
	MOV	M,A
	INX	H
	ORA	A
	JNZ	RD3
	DCR	D
	JNZ	RDLP
;CONVERT AND WRITE
	LXI	D,80H	;OUTPUT BUFFER ADDR
	LXI	H,BUFF
	INX	H	;SKIP NEXT
	INX	H	;..ADDR
LINE	CALL	BIASC	;CONV LINE #
CHAR	MOV	A,M	;GET A CHAR
	INX	H	;POINT TO NEXT
	ORA	A
	JZ	CRLF	;END OF LINE
	JM	KEYWD	;IT IS A TOKEN
;STORE CHAR
	CALL	STORE
	JMP	CHAR
;
CRLF	MVI	A,13
	CALL	STORE
	MVI	A,10
	CALL	STORE
	MOV	A,M	;GET NEXT LINE ADDR
	INX	H
	ORA	M
	INX	H
	JNZ	LINE	;GET NEXT LINE
;
	IF	NOT TEST
;
;ALL DONE - WRITE LAST BLOCK, CLOSE FILE
;
	MVI	A,'Z'-40H ;EOF CHAR
	CALL	STORE
	MVI	C,WRITE
	CALL	DKFNC
	ORA	A
	JNZ	WRERR
	MVI	C,CLOSE
	CALL	DKFNC
;
	ENDIF
	JMP	0
;
;PROCESS KEYWORD
;
KEYWD	PUSH	H	;SAVE INPUT POINTER
	LXI	H,TABLE	;POINT TO KEYWORD TABLE
	SUI	7FH	;FUDGE
	MOV	C,A	;SAVE TOKEN #
	PUSH	D	;SAVE OUTPUT POINTER
KEY10	PUSH	H	;SAVE START OF TOKEN
KEY20	MOV	A,M	;GET CHAR
	INX	H	;POINT TO NEXT
	ORA	A	;SET COND
	JP	KEY20	;KEEP GOING
	DCR	C	;RIGHT TOKEN?
	POP	D	;GET START OF TOKEN ADDR
	JNZ	KEY10	;NOT RIGHT ONE
;
;GOT TOKEN
;
	XCHG		;TOKEN TO H,L
	POP	D	;GET OUTPUT ADDR
;
;MOVE TOKEN TO OUTPUT
;
KEY30	MOV	A,M	;GET CHAR OF TOKEN
	ANI	7FH	;DELETE HI BIT
	CALL	STORE	;STORE IT
	MOV	A,M	;GET CHAR
	INX	H	;POINT TO NEXT
	ORA	A	;END OF TOKEN?
	JP	KEY30	;..NO
	POP	H	;GET INPUT POINTER
	JMP	CHAR
;
;ROUTINE TO STORE OUTPUT, WRITE FULL BUFFER
;
STORE	PUSH PSW ! PUSH B ! PUSH D ! PUSH H
	MOV	E,A
	MVI	C,WRCON
	CALL	BDOS	;PRINT CHAR
	POP H ! POP D ! POP B ! POP PSW
;
	IF	NOT TEST
	STAX	D	;SAVE THE CHAR
	INR	E	;BUMP
	RNZ
	PUSH	B
	MVI	C,WRITE
	CALL	DKFNC	;WRITE A SECTOR
	POP	B
	MVI	E,80H	;RE-INIT BUFFER ADDR
;
	ENDIF
	RET
	IF	NOT TEST
;
;DISK FUNCTIONS - FNC IS IN C
;
DKFNC	PUSH	H
	PUSH	D
	LXI	D,FCB
	CALL	BDOS
	POP	D
	POP	H
	RET
;WRITE ERROR
WRERR	LXI	D,WRERM
	MVI	C,PRINT
	CALL	BDOS
	JMP	0
WRERM	DB	'WRITE ERROR$'
;
	ENDIF
;TARBELL INPUT
TBIN	IN	6EH
	ANI	10H
	JNZ	TBIN
	IN	6FH
	RET
;
;CONVERT LINE $ FROM BINARY TO ASCII
;
BIASC	PUSH	B
	MOV	C,M	;GET LO ORD
	INX	H
	MOV	B,M	;GET HI ORD
	INX	H	;SKIP HI ORD
	PUSH	H
	MOV	H,B
	MOV	L,C
	XRA	A	;ZERO
	STA	ZSFLG	;ZERO SUPPRESS FLAG
	LXI	B,-10000
	CALL	SBT
	LXI	B,-1000
	CALL	SBT
	LXI	B,-100
	CALL	SBT
	LXI	B,-10
	CALL	SBT
	MOV	A,L
	ORI	'0'
	CALL	STORE
	POP	H
	POP	B
	MVI	A,' '
	CALL	STORE	;SPACE AFTER LINE #
	RET
;
;SUBROUTINE TO ADD BC TO HL
;AND COUNT DECIMAL # TIMES
;
SBT	PUSH	D
	MVI	D,'0'
SBTLP	PUSH	H	;SAVE FOR RESTORE
	DAD	B	;'SUBTRACT'
	JNC	NOSBT	;COULDN'T SBTTRACT
	INR	D	;INCR DECIMAL VALUE
	INX	SP	;DELETE
	INX	SP	;SAVED HL
	JMP	SBTLP
NOSBT	POP	H	;RESTORE VALUE
	MOV	A,D	;GET DIGIT
	POP	D
	CPI	'0'	;IF NOT ZERO
	JZ	CKZER	;IS ZERO - CK '0' SUPPRESS
;NOT ZERO - TURN OFF ZERO SUPPRESS FLAG
	STA	ZSFLG
	JMP	STORE	;STORE THE CHAR
;IT IS A ZERO - CHECK FOR ZERO SUPPRESS
CKZER	LDA	ZSFLG	;GET THE FLAG
	ORA	A	;SET COND CODE
	MVI	A,'0'
	JNZ	STORE
	RET		;NO STORE IF SUPPRESSED
;
; 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
FCB	EQU	5CH
TABLE	DB	'EN','D'+128
	DB	'FO','R'+128
	DB	'NEX','T'+128
	DB	'DAT','A'+128
	DB	'INPU','T'+128
	DB	'DI','M'+128
	DB	'REA','D'+128
	DB	'LE','T'+128
	DB	'GOT','O'+128
	DB	'RU','N'+128
	DB	'I','F'+128
	DB	'RESTOR','E'+128
	DB	'GOSU','B'+128
	DB	'RETUR','N'+128
	DB	'RE','M'+128
	DB	'STO','P'+128
	DB	'OU','T'+128
	DB	'O','N'+128
	DB	'NUL','L'+128
	DB	'WAI','T'+128
	DB	'POK','E'+128
	DB	'PRIN','T'+128
	DB	'DE','F'+128
	DB	'CON','T'+128
	DB	'LIS','T'+128
	DB	'CLEA','R'+128
	DB	'DLOA','D'+128
	DB	'DSAV','E'+128
	DB	'NE','W'+128
	DB	'TAB','('+128
	DB	'T','O'+128
	DB	'SPC','('+128
	DB	'F','N'+128
	DB	'THE','N'+128
	DB	'NO','T'+128
	DB	'STE','P'+128
	DB	'+'+128
	DB	'-'+128
	DB	'*'+128
	DB	'/'+128
	DB	'^'+128
	DB	'AN','D'+128
	DB	'O','R'+128
	DB	'>'+128
	DB	'='+128
	DB	'<'+128
	DB	'SG','N'+128
	DB	'IN','T'+128
	DB	'AB','S'+128
	DB	'US','R'+128
	DB	'FR','E'+128
	DB	'IN','P'+128
	DB	'PO','S'+128
	DB	'SQ','R'+128
	DB	'RN','D'+128
	DB	'LO','G'+128
	DB	'EX','P'+128
	DB	'CO','S'+128
	DB	'SI','N'+128
	DB	'TA','N'+128
	DB	'AT','N'+128
	DB	'PEE','K'+128
	DB	'LE','N'+128
	DB	'STR','$'+128
	DB	'VA','L'+128
	DB	'AS','C'+128
	DB	'CHR','$'+128
	DB	'LEFT','$'+128
	DB	'RIGHT','$'+128
	DB	'MID','$'+128 
	DB	0	;END OF TABLE
ZSFLG	DB	0	;ZERO SUPPRESS FLAG
BUFF	EQU	$	;READ PROGRAM IN HERE
	END	100H