;TARBELL SOURCE LOAD
;COMPATIBLE WITH CCOS
;
;DELETES LINE NUMBERS, CHANGES SPACES TO TABS,
;ATTEMPTS TO INSERT ';' BEFORE OPERAND COMMENTS
	ORG	100H	;TO TPA
FCB	EQU	5CH
TFCB	EQU	FCB+16	;TEMP FCB FOR RENAME
TAB	EQU	9	;ASCII TAB
CURS	EQU	3FFEH	;VDM CURSOR
	LXI	SP,STACK ;GET PRIVATE STACK
;IF FILE EXISTS, RENAME IT TO 'NAME.BAK'
	LXI	D,FCB
	MVI	C,SRCHF ;FIND IN DIRECTORY
	CALL	BDOS
	INR	A	;FF=>NOT FOUND
	JZ	NEWF	;NEW FILE
;FILE ALREADY EXISTS - ERASE BACKUP COPY
	LXI	H,FCB	;POINT TO FCB
	LXI	D,TFCB	;POINT TO TEMP FCB
	MVI	B,16	;GET MOVE LENGTH
	CALL	MOVE	;MOVE IT
	LXI	H,BAK	;POINT TO 'BAK'
	LXI	D,TFCB+9
	MVI	B,3	;MOVE LENGTH
	CALL	MOVE
;ERASE BACKUP FILE
	LXI	D,TFCB
	MVI	C,DELT
	CALL	BDOS	;DELETE BACKUP
;RENAME CURRENT NAME TO NAME.BAK
	LXI	D,FCB
	MVI	C,REN
	CALL	BDOS	;RENAME
;MAKE NEW FILE
NEWF	LXI	D,FCB
	MVI	C,MAKE
	CALL	BDOS
	INR	A	;ROOM IN DIRECTORY?
	JNZ	NEWOK	;YES
;NO ROOM IN DIRECTORY
	LXI	D,NORMG
ERXIT	MVI	C,09
	CALL	BDOS	;PRINT ERROR MESSAGE
	JMP	0	;--EXIT--
NORMG	DB	'NO ROOM IN DIRECTORY$'
READY	DB	'TURN ON TAPE $'
BAK	DB	'BAK'
;NEW FILE MAKE WAS OK
;TYPE 'READY' MESSAGE
NEWOK	LXI	D,READY
	MVI	C,9
	CALL	BDOS
;TYPE NAME ON SCREEN
	LHLD	CURS	;GET CURSOR
	MVI	B,5	;FILE NAME LENGTH
	MVI	A,10H	;TARBELL RESET
	OUT	6EH	;RESET
NAME	CALL	TBIN
	MOV	M,A
	INX	H
	DCR	B	;NAME PRINTED?
	JNZ	NAME
	SHLD	CURS
;READ THE TARBELL FILE
	LXI	H,BUFF	;POINT TO END OF PROGRAM
;READ A LINE FROM TARBELL
LINE	CALL	TBIN	;READ LINE LENGTH
	DCR	A	;IS IS EOF?
	JZ	EOF	;YES
;SKIP LINE NO
	MVI	B,5	;NNNN' '
SKIP1	CALL	TBIN
	DCR	B
	JNZ	SKIP1
;READ LABEL, OR BLANK
RDLB	CALL	TBIN
	CPI	'*'
	JZ	COMM	;READ COMMENT IN AS IS
	CPI	' '	;UNLABELED STMT?
	JZ	NOLAB
	CPI	13	;END OF LINE?
	JZ	EOL
;MOVE LABEL
MVLB	MOV	M,A
	CALL	CHECK
	JMP	RDLB	;LOOP READING LABEL
;NO LABEL, OR END OF LABEL
NOLAB	MVI	M,TAB	;STORE TAB CHAR
	CALL	CHECK	;POINT TO OP CODE
;READ OP CODE
RDOP	CALL	TBIN
	CPI	' '
	JZ	ENDOP
	CPI	13
	JZ	EOL	;END OF LINE
	MOV	M,A	;STORE OP CODE CHAR
	CALL	CHECK
	JMP	RDOP	;CONTINUE READING OP CODE
;END OF OP CODE
ENDOP	MVI	M,TAB	;INSERT TAB
	CALL	CHECK
;MOVE OPERAND
MVOPE	CALL	TBIN
	CPI	' '	;END OF OPERAND?
	JZ	BUFFE	;YES
	CPI	13	;END OF LINE?
	JZ	EOL	;YES
	MOV	M,A
	CALL	CHECK
	JMP	MVOPE
;END OF OPERAND
BUFFE	MVI	M,TAB	;TAB TO COMMENTS
	CALL	CHECK
	MVI	A,';'	;OPERAND COMMENT
;MOVE COMMENTS
COMM	MOV	M,A	;STORE '*' OR ';'
	CALL	CHECK
	CALL	TBIN
	CPI	13
	JNZ	COMM
;STORE CR/LF FOR END OF LINE
EOL	MVI	M,13
	CALL	CHECK
	MVI	M,10	;LINEFEED
	CALL	CHECK
	JMP	LINE	;READ NEXT LINE
;EOF REACHED
EOF	MVI	M,'Z'-40H ;EOF CHAR
;OPEN FILE
	LXI	D,FCB
	MVI	C,OPEN
	CALL	BDOS
	INR	A
	JZ	OPERR
;WRITE THE FILE
WRLP	LXI	D,80H	;POINT TO FILE BUFFER
	LHLD	BUFAD	;POINT TO BUFFER
	MVI	B,80H	;MAX MOVE LENGTH
WMOVE	MOV	A,M	;GET CHAR
	STAX	D	;STORE IT
	INX	H
	INX	D
	CPI	'Z'-40H ;EOF?
	JZ	FINAL	;YES, FINAL WRITE
	DCR	B	;128 MOVED?
	JNZ	WMOVE
	CALL	WRSEC	;WRITE THE RECORD
	LHLD	BUFAD	;GET BUFFER ADDRESS
	LXI	D,128	;GET BUFFER LENGTH
	DAD	D	;CALC NEW ADDR
	SHLD	BUFAD	;SAVE BUFFER ADDR
	JMP	WRLP
;WRITE FINAL BLOCK
FINAL	CALL	WRSEC
	LXI	D,FCB
	MVI	C,CLOSE
	CALL	BDOS	;CLOSE THE FILE
	INR	A	;OK?
	JZ	CLSER
	LXI	D,OKMSG
	JMP	ERXIT
OKMSG	DB	'DONE$'
CLSER	LXI	D,CLSERM
	JMP	ERXIT
CLSERM	DB	'CLOSE ERR$'
;WRITE A RECORD
WRSEC	LXI	D,FCB
	MVI	C,WRITE
	CALL	BDOS
	ORA	A	;WROTE OK?
	RZ
;WRITE ERROR
	LXI	D,WERMG
	JMP	ERXIT
WERMG	DB	'WRITE ERR$'
;OPEN ERROR
OPERR	LXI	D,OPERM
	JMP	ERXIT
OPERM	DB	'OPEN ERR$'
;MOVE CHAR ROUTINE, HL TO DE, LENGTH IN B
MOVE	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	MOVE
	RET
;ROUTINE TO INX H AND CHECK MEMORY OVERALY
CHECK	INX	H
	LDA	7	;GET BDOS PAGE ADDR
	CMP	H	;CHECK
	RNC		;RET IF OK
	LDA	6	;GET BDOS PAGE DISPL
	CMP	L
	RNC
;MEMORY OVERLAY
	LXI	D,NOSTG
	JMP	ERXIT
NOSTG	DB	'FILE WON''T FIT IN MEMORY$'
;TARBELL INPUT ROUTINE
TBIN	IN	6EH
	ANI	10H
	JNZ	TBIN
	IN	6FH
	RET
;
	DS	30	;STACK AREA
STACK	DS	2
BUFAD	DW	BUFF
BUFF	EQU	$	;READ PROGRAM INTO HERE
;
; 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