TITLE	BURN
	SUBTTL	PROM burning program

	.Z80
BDOS	EQU	5	;BDOS entry point.
TFCB	EQU	5CH	;Default file control block.
CR	EQU	0DH	;Carriage return.
LF	EQU	0AH	;Line feed.

                org 100h

BURN:	LD	A,(TFCB+1)	;Get the file name.
	CP	" "	;Test for no entry.
	JR	NZ,FILSPC	;Entry made.
	LD	DE,NFNMSG	;No entry present-
OUTBUF:	LD	C,9	;Print string
	JP	BDOS
FILSPC:	LD	DE,TFCB	;Get the file name and
	LD	C,15	;Open file
	CALL	BDOS
	INC	A	;Get file length.
	JR	NZ,FILXIS	;If no file length,
	LD	DE,NFMSG	;print "File not found."
	JR	OUTBUF

FILXIS:	LD	DE,FILBUF	;Point to file buffer
NXTSEC:	PUSH	DE	;and save the pointer.
	LD	C,26	;Set DMA address
	CALL	BDOS
	LD	DE,TFCB	;Get file information
	LD	C,20	;Read sequential
	CALL	BDOS	;into FILBUF.
	OR	A	;EOF?
	JR	NZ,ENDFIL	;yes, end it.
	POP	HL	;No, get next sector and store
	LD	DE,80H	;in FILBUF.
	ADD	HL,DE
	LD	D,H
	LD	E,L
	JR	NXTSEC	;until all entered.

BADPRM:	LD	DE,ERSMSG	;"Prom not erased-"
	JP	OUTBUF

ENDFIL:	LD	DE,PADMSG	;"Enter ROM address (or default):"
	CALL	HEXINP	;Get and test the ROM starting address.
	JR	NZ,NOTDEF	;Use default if no entry.
	LD	HL,4000H	;Default address for ROM.
NOTDEF:	LD	(PRMADR),HL	;Get ROM starting address
	POP	HL	;Get input buffer address.
	LD	DE,FILBUF	;Point to file buffer start.
	OR	A	;Clear flags
	SBC	HL,DE	;Get file length
	PUSH	HL	;and stack it.
	LD	DE,LENMSG	;"File is "
Š	CALL	OUTBUF
	POP	HL	;Get file length again
	PUSH	HL	;but keep on stack.
	LD	A,H
	CALL	HEXOUT	;Print hex values.
	POP	HL	;This is the converted
	PUSH	HL	;length value of file.
	LD	A,L
	CALL	HEXOUT
	LD	DE,LENMS1	;"H bytes long."
	CALL	OUTBUF

INPLEN: LD    	DE,PLNMSÇ  ;"Enteò  ROÍ  length:defaulô  filå"
	CALL	HEXINP	;Read input value.
	POP	DE
	PUSH	DE	;Get but keep file length.
	JR	NZ,NOTLEN	;If no entry, default.
	LD	HL,FILBUF	;get file buffer address.
	LD	H,D	;Now this don't look right.
	LD	L,E
NOTLEN:	LD	A,H
	OR	L       ;Test for length specified.
	RET	Z
	EX	DE,HL
	SBC	HL,DE   ;Test for proper length.
	JR	NC,LENOK
	LD	DE,BDLMSG  ;"PROM not large enough for file."
	CALL	OUTBUF
	JR	INPLEN
LENOK:	EX	DE,HL
	LD	(PRMLEN),HL ;Store PROM length.
	POP	AF          ;Get rom length in A&F
	LD	B,H           
	LD	C,L         ;Put file length in BC
	LD	DE,(PRMADR) ;Point to prom start
	LD	HL,FILBUF   ;Point to file buffer
NXTCHK:	LD	A,(DE)      ;Get first prom cell contents
	CPL
	AND	(HL)        ;Test for ready prom: erased.
	JR	NZ,BADPRM   ;Any entry is badbadbad.
	INC	HL
	INC	DE
	DEC	BC          ;Get each cell in turn 
	LD	A,B
	OR	C           ;test for end-
	JR	NZ,NXTCHK   ;and check each one.
	LD	DE,NUMMSG   ;"Number of times left to write "
	CALL	OUTBUF
	LD	A,32H	;Number of times to write PROM
NXTWRT:	PUSH	AF
	CALL	HEXOUT   ;write count.
	LD	HL,FILBUF
	LD	DE,(PRMADR)  ;Do a block move of bytes
	LD	BC,(PRMLEN)  ;into rom.
	LDIR
Š	LD	E,CR
	CALL	CONOUT
	POP	AF
	DEC	A            ;Keep count in decimal!
	DAA
	JR	NZ,NXTWRT
	LD	DE,(PRMADR)
	LD	HL,FILBUF    ;Set up to verify write.
	LD	BC,(PRMLEN)
NXTVER:	LD	A,(DE)
	CP	(HL)
	JR	Z,PRMOK      ;Verify routine: test each entry.
	CPL                  ;On error, get and print address.
	AND	(HL)
	JR	Z,PRTADR
	LD	(ERSFLG),A   ;Set error flag and
PRTADR:	LD	A,0FFH       ;print address.
	LD	(BADFLG),A
	PUSH	BC
        PUSH	HL
	PUSH	DE
	LD	DE,ADRMSG    ;"Address "
	CALL	OUTBUF
	POP	HL
	PUSH	HL
	LD	A,H     
	CALL	HEXOUT       ;Convert and print address.
	POP	HL
	PUSH	HL
	LD	A,L
	CALL	HEXOUT
	LD	DE,ISMSG     ;"H is "
	CALL	OUTBUF
	POP	HL
	PUSH	HL
	LD	A,(HL)
	CALL	HEXOUT
	LD	DE,SHDMSG    ;"H, should be "
	CALL	OUTBUF
	POP	HL
	POP	DE
	PUSH	DE
	PUSH	HL
	LD	A,(DE)
	CALL	HEXOUT       ;Print correct value.
	LD	E,"H"
	CALL	CONOUT
	CALL	CRLF
	POP	DE
	POP	HL
	POP	BC
PRMOK:	INC	HL
	INC	DE
	DEC	BC
	LD	A,B          ;Continue verifiying cells.
Š	OR	C
	JR	NZ,NXTVER
	LD	A,(BADFLG)   ;Test for previous error reading.
	OR	A
	JR	Z,NOTBAD     ;If first error, exit.
	LD	A,(ERSFLG)   ;Test for multiple errors.
	OR	A
	RET	Z            ;return if not.
	LD	DE,ERSMSG    ;"Prom is bad."
	JP	OUTBUF
NOTBAD:	LD	DE,OKMSG     ;"PROM has been burned and verified.
	JP	OUTBUF

CRLF:	LD	E,CR
	CALL	CONOUT
	LD	E,LF
CONOUT:	LD	C,2	;Console output
	JP	BDOS

HEXINP:	LD	(MSGADR),DE  ;Set message address.
HEXIN1:	LD	DE,(MSGADR)  ;Get message address.
	CALL	OUTBUF       ;and print it.
	LD	DE,INPBUF    ;Point to input buffer
	PUSH	DE           ;and save it.
	LD	C,10	     ;Use input buffer command.
	CALL	BDOS
	CALL	CRLF
	POP	DE           ;Restore message address
	INC	DE           ;bump it 
	LD	A,(DE)       ;get entry length.
	OR	A            ;Quit if no entry.
	RET	Z            
	LD	B,A          ;Save entry length in B.
NXTSPC:	INC	DE           ;Get next cell
	LD	A,(DE)       ;and read it.
	CP	" "          ;If space, 
	JR	NZ,GETHEX    ;skip until ASCII appears.
	DJNZ	NXTSPC
	RET	Z            ;Quit if all spaces.
GETHEX:	LD	HL,0         ;Clear buffer. 
NXTCHR:	LD	A,(DE)       ;Get character
	SUB	"0"          ;Convert to binary.
	JR	C,HEXERR     ;Error if less than ASCII 0.
	CP	10           ;Test for =>9
	JR	C,HEXOK
	CP	"A"-"0"      
	JR	C,HEXERR     ;Test for A through F only.
	CP	"F"+1-"0"
	JR	NC,HEXERR
	SUB	7            ;Convert ASCII to binary.
HEXOK:	PUSH	BC           ;Save entry length.
	LD	B,4          ;Set counter
NXTSHF:	SLA	L
	RL	H
	JR	C,TOOLRG     ;Test for number size-
Š	DJNZ	NXTSHF       ;write message and exit if   
	POP	BC           ;excessive.
	OR	L
	LD	L,A
	INC	DE
	DJNZ	NXTCHR       ;Continue until all cells checked.
	INC	B	     ;Clear Z flag, B=1.
	RET

HEXOUT:	PUSH	AF
	RRCA
	RRCA
	RRCA
	RRCA
	CALL	HEXOT1       ;Hex conversion and print routine.
	POP	AF
HEXOT1:	AND	0FH
	ADD	A,90H
	DAA
	ADC	A,40H
	DAA
	LD	E,A
	JR	CONOUT

HEXERR:	LD	DE,HEXMSG    ;"Invalid hex digit found."
	CALL	OUTBUF
	JR	HEXIN1

TOOLRG:	LD	DE,LRGMSG    ;"Number too large."
	POP	BC	     ;Clean stack
	CALL	OUTBUF
	JR	HEXIN1

HEXMSG:	DEFB	"Invalid hex digit found",CR,LF,"$"
LRGMSG:	DEFB	"Number too large",CR,LF,"$"
NFNMSG:	DEFB	"No file name specified$"
NFMSG:	DEFB	"File not found$"
LENMSG:	DEFB	"File is $"
LENMS1:	DEFB	"H bytes long",CR,LF,"$"
PADMSG:	DEFB	"Enter first address of PROM (default is 4000H):$"
PLNMSG:	DEFB	"Enter length of PROM (default is length of file):$"
BDLMSG:	DEFB	"PROM length must not be greater than file length",CR,LF,"$"
NUMMSG:	DEFB	"Number of times left to write:",CR,LF,"$"
ADRMSG:	DEFB	"Address $"
ISMSG:	DEFB	"H is $"
SHDMSG:	DEFB	"H, should be $"
ERSMSG:	DEFB	"PROM is bad, must be erased before reprogramming$"
OKMSG:	DEFB	"PROM has been burned and verified$"

ERSFLG:	DEFB	0
BADFLG:	DEFB	0
INPBUF:	DEFB	8
END:	DEFS	9
PRMADR:	DEFS	2
PRMLEN:	DEFS	2
ŠMSGADR:	DEFS	2
FILBUF:	ORG	END
	END	BURN